;; -*-theme-d-*-

;; Copyright (C) 2015, 2020, 2021, 2022, 2025 Tommi Höynälänmaa

;; This file is based on file gtk/examples/hello.scm in package
;; guile-gnome-platform 2.16.2.

;; This file is part of Theme-D-Intr.

;; You can redistribute and/or modify this file under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any
;; later version.

;; This file 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, see https://www.gnu.org/licenses/.


(define-proper-program (intr-gtk4-examples hello2 main)
  
  (import (standard-library core)
          (standard-library list-utilities)
          (intr-gtk4-examples hello2 _intr-imports))
  
  (define-simple-method activate-my-app
      (((args (rest <object>))) <object> nonpure)
    (let* ((app (cast <gtk-application> (uniform-list-ref args 0)))
           (window (cast <gtk-window> (gtk-application-window-new app)))
           (button (cast <gtk-button>
                         (gtk-button-new-with-label "Hello, World!"))))
      (slot-set! window 'width-request 400)
      (slot-set! window 'height-request 300)
      ;; (set-border-width window 10)
      (gtk-window-set-child window button)
      (gtype-instance-signal-connect
       button 'clicked
       (lambda (((args (rest <object>))) <object> nonpure)
         (g-application-quit app)
         null))
      (gtk-window-present window)
      (gtk-widget-show button)
      #f))
  
  (define-main-proc (() <none> nonpure)
    (let* ((str-app-name "org.tohoyn.hello2")
           (app (gtk-application-new str-app-name null)))
      (g-set-prgname str-app-name)
      (gtype-instance-signal-connect
       app 'activate activate-my-app)
      (let ((status (run app null)))
        status))))
