#! /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 iface-name signal-name parameters user-data)
  (dimfi 'on-my-signal)
  (dimfi (format #f "~20,,,' @A:" "Received a signal") signal-name)
  (dimfi (format #f "~20,,,' @A:" "interface") iface-name))

(define (subscribe-signal conn)
  (gd-bus-connection-signal-subscribe
   conn
   "fi.tohoyn.DBusServer1"      ; sender
   "fi.tohoyn.DBusServer1"      ; interface
   "MySignal"                   ; signal
   "/fi/tohoyn/DBusServer1"     ; object path
   #f                           ; arg0 filter
   '()                          ; flags
   on-my-signal                 ; callback
   #f                           ; user data
   #f))                         ; user data free func

(define (dbus-call conn str-method l-vnt-args str-result-type)
  (gd-bus-connection-call-sync
   conn
   "fi.tohoyn.DBusServer1"               ; bus name
   "/fi/tohoyn/DBusServer1"              ; object path
   "fi.tohoyn.DBusServer1"               ; interface
   str-method                            ; method
   (g-variant-new-tuple l-vnt-args)      ; arguments
   (g-variant-type-new str-result-type)  ; expected reply type
   '()                                   ; flags
   -1                                    ; timeout
   #f))                                  ; cancellable

(define (main args)
  (letrec ((debug? (or (member "-d" args)
                       (member "--debug" args)))
           (animate
            (lambda ()
                    (let* ((loop (g-main-loop-new))
                           (conn (g-bus-get-sync 'session #f))
                           (i-subscription (subscribe-signal conn))
                           (vnt-result1
                            (dbus-call conn
                                       "MyMethod1"
                                       (list
                                        (g-variant-new-string
                                         "Lucky number"))
                                       "(x)"))
                           (vnt-result2
                            (dbus-call conn
                                       "MyMethod2"
                                       (list
                                        (g-variant-new-int64 10))
                                       "(sx)")))
                      (dimfi 'main)
                      (dimfi (format #f "~20,,,' @A:" "subscription")
                             i-subscription)
                      (dimfi (format #f "~20,,,' @A:" "Result of MyMethod1")
                             (g-variant-get-int64
                              (g-variant-get-child-value vnt-result1 0)))
                      (dimfi (format #f "~20,,,' @A:" "Result of MyMethod2")
                             (g-variant-get-string
                              (g-variant-get-child-value vnt-result2 0))
                              ","
                              (g-variant-get-int64
                               (g-variant-get-child-value vnt-result2 1)))
                      (g-main-loop-run loop)))))
    (if debug?
        (parameterize ((%debug #t)) (animate))
        (animate))))