#! /bin/sh
# -*- mode: scheme; coding: utf-8 -*-
exec guile -e main -s "$0" "$@"
!#

(eval-when (expand load eval)
  (use-modules (oop goops))

  (default-duplicate-binding-handler
    '(merge-generics replace warn-override-core warn last))

  (use-modules (g-golf))

  (g-irepository-require "Gio")
  (for-each (lambda (name)
              (gi-import-by-name "Gio" name))
      '("DBusConnection"
        "bus_get_sync")))

(define (on-my-signal connection
                      sender object-path interface-name signal-name parameters user-data)
  (dimfi 'on-my-signal)
  (dimfi (format #f "~20,,,' @A:" "connection") connection)
  (dimfi (format #f "~20,,,' @A:" "sender") sender)
  (dimfi (format #f "~20,,,' @A:" "objec-path") object-path)
  (dimfi (format #f "~20,,,' @A:" "interface name") interface-name)
  (dimfi (format #f "~20,,,' @A:" "signal-name") signal-name))

(define (subscribe-signal connection)
  (signal-subscribe connection
                    "org.gnu.test.DBus"   ; sender
                    "org.gnu.test.DBus"   ; interface-name
                    "Signal1"             ; signal-name
                    "/org/gnu/test/DBus" ; object-path
                    #f                    ; arg0 filter
                    '()                   ; flags
                    on-my-signal          ; callback
                    #f                    ; user data
                    #f))                  ; user data free func

(define (dbus-call-sync connection method-name args result-type)
  (call-sync connection
             "org.gnu.test.DBus"                  ; bus-name
             "/org/gnu/test/DBus"                 ; object-path
             "org.gnu.test.DBus"                  ; interface-name
             method-name                          ; method-name
             (g-variant-new-tuple args)           ; parameters
             (g-variant-type-new result-type)     ; reply-type
             '()                                  ; flags
             -1                                   ; timeout-msec
             #f))                                 ; cancellable

(define (main args)
  (letrec ((debug? (or (member "-d" args)
                       (member "--debug" args)))
           (animate
            (lambda ()
                    (let* ((loop (g-main-loop-new))
                           (connection (g-bus-get-sync 'session #f))
                           (s-id (subscribe-signal connection))
                           (m1-result
                            (dbus-call-sync connection
                                            "Method1"
                                            `(,(g-variant-new-string "Lucky number"))
                                            "(x)"))
                           (m2-result
                            (dbus-call-sync connection
                                            "Method2"
                                            `(,(g-variant-new-int64 10))
                                            "(sx)")))
                      (dimfi (format #f "~20,,,' @A:" "Result of Method1")
                             (g-variant-get-int64
                              (g-variant-get-child-value m1-result 0)))
                      (dimfi (format #f "~20,,,' @A:" "Result of Method2")
                             (g-variant-get-string
                              (g-variant-get-child-value m2-result 0))
                             (g-variant-get-int64
                              (g-variant-get-child-value m2-result 1)))
                      (g-main-loop-run loop)))))
    (if debug?
        (parameterize ((%debug #t)) (animate))
        (animate))))