;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gui events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; bitmask, currently pressed buttons.
;; used by event dispatcher, should be managed by the main code.
;; automatically reset after broadcasting the global blur.
;; automatically modified *AFTER* button down and *BEFORE* button up events.
;; i.e. for 'MOUSE-DOWN, it is modified after the event was handled.
;; but for 'MOUSE-UP, it is modified before the event will be handled.
;; it is more useful this way.
(define mouse-button-state 0)
;; this one is always modified *AFTER* the event was handled.
;; useful in 'MOUSE-UP handling.
(define mouse-button-state-last 0)

;; the same for keyboard modifiers. set after 'KEY-DOWN, reset before 'KEY-UP.
(define keyboard-mods-state 0)
(define keyboard-mods-state-last 0)

(define need-repaint-gui #f)

(define (need-repaint?) need-repaint-gui)
(define (need-repaint-reset!) (gset! need-repaint-gui #f))
(define (need-repaint!) (gset! need-repaint-gui #t))


(constant BUTTON-LEFT sdl:BUTTON-LEFT)
(constant BUTTON-RIGHT sdl:BUTTON-RIGHT)
(constant BUTTON-MIDDLE sdl:BUTTON-MIDDLE)
(constant BUTTON-LEFT-MASK sdl:BUTTON-LEFT-MASK)
(constant BUTTON-RIGHT-MASK sdl:BUTTON-RIGHT-MASK)
(constant BUTTON-MIDDLE-MASK sdl:BUTTON-MIDDLE-MASK)
(constant KMOD-LEFT-SHIFT-MASK sdl:KMOD-LEFT-SHIFT-MASK)
(constant KMOD-RIGHT-SHIFT-MASK sdl:KMOD-RIGHT-SHIFT-MASK)
(constant KMOD-SHIFT-MASK sdl:KMOD-SHIFT-MASK)
(constant KMOD-LEFT-ALT-MASK sdl:KMOD-LEFT-ALT-MASK)
(constant KMOD-RIGHT-ALT-MASK sdl:KMOD-RIGHT-ALT-MASK)
(constant KMOD-ALT-MASK sdl:KMOD-ALT-MASK)
(constant KMOD-LEFT-CTRL-MASK sdl:KMOD-LEFT-CTRL-MASK)
(constant KMOD-RIGHT-CTRL-MASK sdl:KMOD-RIGHT-CTRL-MASK)
(constant KMOD-CTRL-MASK sdl:KMOD-CTRL-MASK)
(constant KMOD-LEFT-HYPER-MASK sdl:KMOD-LEFT-HYPER-MASK)
(constant KMOD-RIGHT-HYPER-MASK sdl:KMOD-RIGHT-HYPER-MASK)
(constant KMOD-HYPER-MASK sdl:KMOD-HYPER-MASK)

#|
mouse event handling idea is borrowed from X11.
when any mouse button pressed, all mouse and keyboard events will
be directly sent to the active widget until all mouse buttons are
released. the events will still sink, but they will have their
destination set to the widget object, and will not be sent to other
widgets. i.e. mouse motion event will not be sent to the widges
mouse is hovering on.

post-bubble keyboard broadcasts will NOT be sent in "mouse grab" mode.

you should check "destination:" property in MOUSE-MOTION handler to
see if this event is "grabbed".

note that this logic is implemented in "window-frame:" widget, it is
not hard-coded.
|#


#|
special broadcast events.

NEXT-TAB-WIDGET
  `user-data` will be set by the active widget (to itself).
  if activable widget will see it set, it should replace it with itself, and eat the event.
  send from the top level, check if the message is eaten.
  if it is eaten, then `user-data` contains next widget in tab order (object).

PREV-TAB-WIDGET
  exactly the same as "NEXT-TAB-WIDGET", but propagates the event from the last child.
  send from the top level, check if the message is eaten.
  if it is eaten, then `user-data` contains previous widget in tab order (object).

FIRST-TAB-WIDGET
  first activable widget will set `user-data` to itself, and eat the event.
  if it is eaten, then `user-data` contains first widget in tab order (object).

LAST-TAB-WIDGET
  exactly the same as "FIRST-TAB-WIDGET", but propagates the event from the last child.
  if it is eaten, then `user-data` contains first widget in tab order (object).

ACTIVATE-WIDGET
  `source` is set to the widget we want to activate.
  there is no way to prevent the activation.
  there is no result. it Just Works.
  send from the top level.
  WARNING! the sender should check if the destination widget is selectable
           before sending this event.


WINDOW-BLUR
  broadcasted when the window loses the focus (i.e. became non-active).
  you can call `close-window:` in this handler.
  note that this could be send to already unfocused window.

WINDOW-FOCUS
  broadcasted when the window gains the focus (i.e. became non-active).
  you can call `close-window:` in this handler.
  note that this could be send to already focused window.


listbox broadcasts.
source: listbox.
types:
  clear-items:
    sent before items are cleared.
  append-item:
    sent before the item was appended.
    user-data: item string
  current-item-set!:
    user-data: item index
    sent before the current item index changes.
  delete-item:
    user-data: item index
    sent before the current item deleted.

radio broadcasts:
source: radio widget.
user-data: group id (string)
types:
  radio-marked: source is active now
  radio-get-marked: source will be set to the selected widget, or #nil

checkbox broadcasts:
source: checkbox widget.
types:
  checkbox-marked:
  checkbox-unmarked:
|#


define new-gui-event(type)
  ;; event tick time
  define time ticks-msec()
  ;; global mouse pointer coords (i.e. not local to any widget).
  ;; should be fixnums.
  define gx 0
  define gy 0
  ;; local mouse pointer coords, set before calling any widget event handler
  ;; should be fixnums.
  define x 0
  define y 0
  ;; mouse wheel scroll amount
  define wheel-x 0  ;; negative: left
  define wheel-y 0  ;; negative: up
  ;; mouse wheel precise scroll amount, fractional
  define wheel-precise-x 0
  define wheel-precise-y 0
  ;; mouse button pressed, or button mask for motion event
  define button 0
  ;; unreliable field from SDL, will prolly be removed later
  define clicks 0
  ;; relative mouse motion for motion event.
  ;; can be fractional.
  define rel-x 0
  define rel-y 0
  ;; pressed/released keyboard key in emacs notation. string.
  define keysym #nil
  ;; source and destination widgets for broadcasted events.
  define source #nil
  define destination #nil
  ;; set if event was consumed by some widget.
  ;; automatically triggers redraw.
  define eaten #f
  ;; set if event was cancelled for some reason.
  ;; doesn't trigger redraw.
  define cancelled #f
  ;; if set, even unconsumed or cancelled event will trigger redraw.
  define dirty #f
  ;; any modifiers pressed?
  define any-mods #f
  ;; text for TEXT-INPUT
  define text #nil
  ;; is this broadcasted key handler?
  define key-broadcast #f
  ;; broadcast type
  define broadcast-type #nil
  ;; arbitrary used data. useful for broadcast events, for example.
  define user-data #nil
  ;;
  method-lambda gui-event
    super: (self)
      #nil
    event?: (self)
      #t
    time: (self)
      time
    type: (self)
      type
    type-set!: (self value)
      {type := value}
      self
    eaten?: (self)
      eaten
    eat!: (self)
      {eaten := #t}
      self
    cancelled?: (self)
      cancelled
    cancel!: (self)
      {cancelled := #t}
      self
    dirty?: (self)
      {dirty or eaten or need-repaint-gui}
    dirty!: (self)
      {dirty := #t}
      need-repaint!()
      self
    alive?: (self)
      {not {eaten or cancelled}}
    any-mods?: (self)
      any-mods
    any-mods!: (self)
      {any-mods := #t}
      self
    key-broadcast?: (self) key-broadcast
    key-broadcast!: (self)
      {key-broadcast := #t}
      #t
    key-broadcast-set!: (self value)
      assert {boolean? value} "invalid value for key-broadcast event property"
      {key-broadcast := value}
      #t
    gx: (self) gx
    gx-set!: (self value)
      assert {number? value} "invalid event gx value"
      {gx := value}
      self
    gy: (self) gy
    gy-set!: (self value)
      assert {number? value} "invalid event gy value"
      {gy := value}
      self
    x: (self) x
    x-set!: (self value)
      assert {number? value} "invalid event x value"
      {x := value}
      self
    y: (self) y
    y-set!: (self value)
      assert {number? value} "invalid event y value"
      {y := value}
      self
    rel-x: (self) rel-x
    rel-x-set!: (self value)
      assert {number? value} "invalid event rel-x value"
      {rel-x := value}
      self
    rel-y: (self) rel-y
    rel-y-set!: (self value)
      assert {number? value} "invalid event rel-y value"
      {rel-y := value}
      self
    wheel-x: (self) wheel-x
    wheel-x-set!: (self value)
      assert {number? value} "invalid event wheel-x value"
      {wheel-x := value}
      self
    wheel-y: (self) wheel-y
    wheel-y-set!: (self value)
      assert {number? value} "invalid event wheel-y value"
      {wheel-y := value}
      self
    wheel-precise-x: (self) wheel-precise-x
    wheel-precise-x-set!: (self value)
      assert {number? value} "invalid event wheel-precise-x value"
      {wheel-precise-x := value}
      self
    wheel-precise-y: (self) wheel-precise-y
    wheel-precise-y-set!: (self value)
      assert {number? value} "invalid event wheel-precise-y value"
      {wheel-precise-y := value}
      self
    button: (self) button
    button-set!: (self value)
      assert {fixnum? value} "invalid event button value"
      {button := value}
      self
    clicks: (self) clicks
    clicks-set!: (self value)
      assert {fixnum? value} "invalid event clicks value"
      {clicks := value}
      self
    keysym: (self) keysym
    keysym-set!: (self value)
      {keysym := value}
      self
    text: (self)
      if {string? text}
        text
        ""
    text-set!: (self value)
      cond
        {{fixnum? value} and between?(value 0 255)}
          {text := string-append("" value)}
        {string? value}
          {text := value}
        {symbol? value}
          {text := symbol->string(value)}
        else
          error "invalid event text"
      self
    destination: (self) destination
    destination-set!: (self value)
      {destination := value}
      self
    source: (self) source
    source-set!: (self value)
      {source := value}
      self
    broadcast-type: (self) broadcast-type
    broadcast-type-set!: (self value )
      {broadcast-type := value}
      self
    user-data: (self) user-data
    user-data-set!: (self value)
      {user-data := value}
      self
