;; -*-theme-d-*-

;; Copyright (C) 2015, 2020-2023 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 hello3 main)

  (import (standard-library core)
	  (standard-library list-utilities)
	  (standard-library console-io)
	  (intr-gtk4-examples hello3 _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!"))))
      (gtk-widget-set-width-request window 350)
      (gtk-widget-set-height-request window 300)
      (slot-set! window 'width-request
                 (+ (slot-ref window 'width-request) 50))
      (set-border-width window 10)
      (add 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)
      (console-display "pointer: ")
      (console-display-line (gtk-widget-get-pointer window))
      (console-display "pointer: ")
      (console-display-line (get-pointer window))
      (console-display-line
       (gtk-widget-intersect window (list 10 10 200 100)))
      #f))

  (define-main-proc (() <none> nonpure)
    (let* ((str-app-name "org.tohoyn.hello3")
	   (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))))
