;;;;
;;;; events.stk                                  -- GTK Events Management
;;;;
;;;; Copyright © 2001-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program 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 the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 31-May-2001 18:36 (eg)
;;;;

;;;
;;; GTK bindings
;;;
(define-external g-signal-connect-data ((widget #:pointer)  (name #:string)
                                        (proc #:pointer)    (data #:obj)
                                        (unused1 #:pointer) (unused2 :int))
  :entry-name "g_signal_connect_data"
  :library-name (find-gtk-library 'gobject))


;;; ______________________________________________________________________
;;;
;;; Low level signal management
;;;
;;; ----------------------------------------------------------------------
(define (%do-signal-connect widget name proc data after)
  (let ((cb (make-callback proc
                           '(#:pointer)
                           data)))
    ;; This call correspond to the C call
    ;;     g_signal_connect_swapped(widget, name, callback, cb);
    ;; The value 2 below correspond to swapped callbacks where the user data
    ;; is the first argument of the callback
    (g-signal-connect-data widget
                           name
                           (%exec-callback-address)
                           cb
                           (void)
                           (+ 2 (if after 1 0)))))


(define (g-signal-connect widget name proc data)
  (let ((closure (lambda (w widget) (proc widget))))
    (%do-signal-connect widget name closure widget #f)))


(define (g-signal-connect-after widget name proc data)
  (let ((closure (lambda (w widget) (proc widget))))
    (%do-signal-connect widget name closure widget #t)))



;; GTK handlers can have a variable number of parameters depending of the signal
;; For instance
;;     - a clicked button handler will be called with the gtk-widget and
;;       the user given data
;;     - a keypress handler will be called with the gtk-widget the keypress and
;;       and the user given data
;; To simplify Scheme code, all STklos handlers take 2 parameters, the scheme
;; widget object on which the signal occurs and an event object.
;;
(define (%make-event-getter-func name)
  (let ((key (make-keyword name)))
    (lambda (o)
      (key-get (slot-ref o '%event) key #f))))


(define (%make-event-setter-func name)
  (let ((key (make-keyword name)))
    (lambda (o v)
      (let ((old (key-get (slot-ref o '%event) key #f)))
        (unless old
          ;; Firsst time that we use this siggnal on this widget
          (g-signal-connect
                  (slot-ref o 'wid)
                  name
                  (lambda _
                    ;; Call the function stored with this event key with
                    ;;     - the object itself
                    ;;     - the current event object
                    (  (key-get (slot-ref o '%event) key)
                       o
                       (get-gtk-event)))
                  (void)))
        ;; Stoore the value v in the %event slot
        (slot-set! o '%event (key-set! (slot-ref o '%event) key v))))))


(define (scheme-proc->gtk-handler proc scheme-widget)
  ;; GTK handlers can have a variable number of parameters depending of the signal
  ;; For instance
  ;;     - a clicked button handler will be called with the gtk-widget and
  ;;       the user given data
  ;;     - a keypress handler will be called with the gtk-widget the keypress and
  ;;       and the user given data
  ;; To simplify Scheme code, all handlers take 2 parameters, the scheme widget object
  ;; and an event object.
  (lambda _    ;; We don't care of the parameters here.
    ;; call the user handler with 2 parameters
    (proc scheme-widget (get-gtk-event))))

; ======================================================================

(define (%virtual-event-getter-func name)
  (let ((key (make-keyword name)))
    (lambda (o)
      (key-get (slot-ref o '%event) key #f))))


(define (%virtual-event-setter-func name)
  (let ((key (make-keyword name)))
    (lambda (o v)
      (g-signal-connect (slot-ref o 'wid)
                        key
                        (scheme-proc->gtk-handler v o)
                        (void))
      (slot-set! o
                 '%event
                 (key-set! (slot-ref o '%event) key v)))))

(define (event-describe e)
  (eprintf "event description ~S\n" e)
  (eprintf "\t     type: ~S\n" (event-type e))
  (eprintf "\t   button: ~S\n" (event-button e))
  (eprintf "\tmodifiers: ~S\n" (event-modifiers e))
  (eprintf "\t     char: ~S\n" (event-char e))
  (eprintf "\t        x: ~S\n" (event-x e))
  (eprintf "\t        y: ~S\n" (event-y e)))


;;;
;;; Exports
;;;
(export g-signal-connect g-signal-connect-after
        event-char event-modifiers event-button event-x event-y event-type
        event-keyval event-describe)
