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


;;;;
;;;; Copyright (C) 2022 - 2023
;;;; Free Software Foundation, Inc.

;;;; This file is part of GNU G-Golf

;;;; GNU G-Golf is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU Lesser General Public License as
;;;; published by the Free Software Foundation; either version 3 of the
;;;; License, or (at your option) any later version.

;;;; GNU G-Golf 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
;;;; Lesser General Public License for more details.

;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with GNU G-Golf.  If not, see
;;;; <https://www.gnu.org/licenses/lgpl.html>.
;;;;

;;; Commentary:

;; This example requires the following GNOME setting

;; 	Tweaks (gnome-tweaks) setting application,
;; 		-> General
;; 			Animations	ON
;; 			[ I had it ON, but it became OFF after some
;; 			[ updates, and I didn't think about that ...

;;; Code:


(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 "Gtk" #:version "4.0")
  (for-each (lambda (name)
              (gi-import-by-name "Gtk" name))
      '("Application"
        "ApplicationWindow"
        "Builder"
        "Revealer")))

(define (get-revealers builder)
  (let loop ((i 0)
             (result '()))
    (if (= i 10)
        (reverse! result)
        (let ((name (string-append "revealer"
                                   (number->string i))))
          (loop (+ i 1)
                (cons (get-object builder name)
                      result))))))

(define (change-direction revealer)
  (when (get-mapped revealer)
    (set-reveal-child revealer
                      (not (get-child-revealed revealer)))))

(define (activate app)
  (let ((builder (make <gtk-builder>))
        (ui (string-append (getcwd) "/ui/revealer.ui")))
    (if (add-from-file builder ui)
        (let ((window (get-object builder "window"))
              (revealers (get-revealers builder))
              (count 0))
          (g-timeout-add 690
                         (lambda ()
                           (let ((revealer (list-ref revealers count)))
                             (set-reveal-child revealer #t)
                             (connect revealer
                                      'notify::child-revealed
                                      (lambda (r param)
                                        (change-direction r)))
                             (set! count (1+ count))
                             (if (>= count 9)
                                 #f
                                 #t))))
          (add-window app window)
          (present window))
        ;; actually, the g-error has been catch by with-g-error already
        ;; so the code below, till we define and use scheme exceptions,
        ;; is currently a dead code.
        (error "<gtk-builder> - add-from-file failed: " ui))))

(define (main args)
  (let ((app (make <gtk-application>
               #:application-id "org.gtk.example")))
    (connect app 'activate activate)
    (let ((status (run app '())))
      (exit status))))
