;; -*-theme-d-*-

;; Copyright (C) 2022 Tommi Höynälänmaa

;; 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 appwindow main)

  (import (standard-library core)
	  (standard-library list-utilities)
	  (standard-library string-utilities)
	  (standard-library console-io)
	  (standard-library object-string-conversion)
	  (theme-d-intr support)
	  (intr-gtk4-examples appwindow _intr-imports))

  (define-simple-method error (((str <string>)) <none> never-returns)
    (console-display-line str)
    (console-newline)
    (exit 1))

  (define getcwd
    (prim-proc getcwd () <string> pure))

  (define connect gtype-instance-signal-connect)
  
  (define-simple-method application-settings
      (((str-name <string>)) <g-settings> nonpure)
    (let* ((src (g-settings-schema-source-new-from-directory "@programdir@"
							     #f #f))
	   (schema (g-settings-schema-source-lookup src str-name #f)))
      (g-settings-new-full (cast <pointer> schema) #f #f)))

  (define-simple-method update-statusbar (((textbuffer <gtk-text-buffer>)
					   (statusbar <gtk-statusbar>))
					  <none>
					  nonpure)
    (let ((iter (get-iter-at-mark
		 textbuffer
		 (get-insert textbuffer))))
      (pop statusbar 0)
      (push
       statusbar
       0
       (string-append
	"Cursor at row "
	(integer->string (gtk-text-iter-get-line iter))
	" column "
	(integer->string (gtk-text-iter-get-line-offset iter))
	" - "
	(integer->string (get-char-count textbuffer))
	" chars in document"))))

  (define-simple-method show-message-dialog
      (((window-parent <gtk-window>) (str-text <string>)) <none> nonpure)
    (let ((dialog
	   (cast <adw-message-dialog>
		 (adw-message-dialog-new
		  window-parent "Menu item activated" str-text))))
      (set-size-request dialog 250 150)
      (set-transient-for dialog window-parent)
      (add-response dialog "close" "Close")
      (set-default-response dialog "close")
      (set-close-response dialog "close")
      (connect dialog 'response
	       (lambda (((l-args (rest <object>))) <boolean> nonpure)
		 (destroy dialog)
		 #f))
      (present dialog)))
  
  (define-simple-method startup-my-app
      (((args (rest <object>))) <object> nonpure)
    (let* ((app (cast <gtk-application> (uniform-list-ref args 0)))
	   (builder (gtk-builder-new))
	   (ui "@programdir@/appwindow.ui"))
      (case (add-from-file builder ui)
        ((#f)
	 (error (string-append "<gtk-builder> - add-from-file failed: " ui)))
	(else
	 (let ((menubar (cast <g-menu-model> (get-object builder "menubar"))))
           (set-menubar app menubar)
	   (g-object-unref builder)
	   #f)))))

  (define-simple-method activate-my-app
      (((args (rest <object>))) <object> nonpure)
    (let* ((app (cast <gtk-application> (uniform-list-ref args 0)))
	   (window (cast <gtk-application-window>
			 (gtk-application-window-new app)))
	   (box (cast <gtk-box> (gtk-box-new 'vertical 1)))
	   ;; (actiongroup (gtk-action-group-new "AppWindowActions"))
	   ;; (uimanager (gtk-ui-manager-new))
	   (scrwin
	    (cast <gtk-scrolled-window> (gtk-scrolled-window-new)))
	   (textbuffer (gtk-text-buffer-new #f))
	   (textview
	    (cast <gtk-text-view> (gtk-text-view-new-with-buffer textbuffer)))
	   (statusbar (cast <gtk-statusbar> (gtk-statusbar-new)))
	   (box-toolbar (cast <gtk-box> (gtk-box-new 'horizontal 1)))
	   (button-open (gtk-button-new-from-icon-name "document-open"))
	   (button-quit (gtk-button-new-from-icon-name "application-exit"))
	   (settings (application-settings "org.tohoyn.appwindow"))
	   (a-quit (g-simple-action-new "quit" #f))
	   (a-color (create-action settings "color"))
	   (a-shape (create-action settings "shape"))
	   (a-bold (create-action settings "bold")))
      (add-action app a-quit)
      (connect a-quit
               'activate
               (lambda (((l-args (rest <object>))) <boolean> nonpure)
                 (for-each1 (lambda (((win <object>)) <none> nonpure)
                              (destroy (cast <gtk-window> win)))
			    (get-windows app))
                 #f))
      (add-action app a-color)
      (add-action app a-shape)
      (add-action app a-bold)
      (set-show-menubar window #t)
      (set-title window "Application Window")
      ;; (gobject-set-property window 'default-width 200)
      ;; (gobject-set-property window 'default-height 200)
      (set-size-request window 500 400)
      (set-policy scrwin 'automatic 'automatic)
      ;; (set-shadow-type scrwin 'in)
      (set-vexpand scrwin #t)
      
      (set-child window box)
      (gtk-box-append box box-toolbar)
      (gtk-box-append box-toolbar button-open)
      (gtk-box-append box-toolbar button-quit)
      
      (gtk-box-append box scrwin)
      (grab-focus textview)
      (set-child scrwin textview)
      (gtk-box-append box statusbar)
      
      (connect
       textbuffer 'changed
       (lambda (((l-args (rest <object>))) <object> nonpure)
	 (update-statusbar textbuffer statusbar)
	 #f))
      (connect
       textbuffer 'mark-set
       (lambda (((l-args (rest <object>))) <object> nonpure)
	 (update-statusbar textbuffer statusbar)
	 #f))
      (connect
       window 'close-request
       (lambda (((l-args (rest <object>))) <object> nonpure)
	 (destroy window)
	 #f))
      (connect settings 'changed::color
	       (lambda (((l-args (rest <object>))) <boolean> nonpure)
		 (show-message-dialog
		  window
		  (string-append
		   "Color activated: "
		   (integer->string (get-enum settings "color"))))
		 #f))      
      (connect settings 'changed::shape
	       (lambda (((l-args (rest <object>))) <boolean> nonpure)
		 (show-message-dialog
		  window
		  (string-append
		   "Shape activated: "
		   (integer->string (get-enum settings "shape"))))
		 #f))
      (connect settings 'changed::bold
	       (lambda (((l-args (rest <object>))) <boolean> nonpure)
		 (show-message-dialog
		  window
		  (string-append
		   "bold activated: "
		   (if (get-boolean settings "bold") "#t" "#f")))
		 #f))
      (update-statusbar textbuffer statusbar)
      (show window)
      #f))

	   
  (define-main-proc (() <none> nonpure)
    (let* ((str-app-name "org.tohoyn.appwindow")
	   (app (gtk-application-new str-app-name null)))
      (gtype-instance-signal-connect
       app 'startup startup-my-app)
      (gtype-instance-signal-connect
       app 'activate activate-my-app)
      (let ((status (g-application-run app null)))
	status))))
