
;; Copyright (C) 2016, 2021  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-body (intr-gtk4-examples theme-d-intr-demo dialog)

  (import (standard-library object-string-conversion)
	  (standard-library string-utilities)
	  (standard-library list-utilities)
	  (intr-gtk4-examples theme-d-intr-demo _intr-imports)
	  (intr-gtk4-examples theme-d-intr-demo support))


  (define connect gtype-instance-signal-connect)

  (define-mutable gl-i-counter <integer> 0)

  ;; Should this be nonpure?
  (define gtk-message-dialog-new1
    (prim-proc gtk-message-dialog-new1
	       (<symbol> <string>) <gtk-widget> pure))

  (define-simple-proc on-dialog-response-close
      (((args (rest <object>))) <object> nonpure)
    (let ((dialog (cast <gtk-dialog> (uniform-list-ref args 0))))
      (gtk-window-destroy dialog)
      null))
  
  (define-simple-method message-dialog-clicked
      (((window-parent <gtk-window>)) <none> nonpure)
    (let ((dialog
	   (cast <gtk-message-dialog>
		 (gtk-message-dialog-new1
		  'ok
  		  (string-append
  		   "This message box has been popped up "
  		   "the following\n"
  		   "number of times:\n\n"
  		   (integer->string gl-i-counter))))))
      (set-transient-for dialog window-parent)
      ;; (run dialog)
      ;; (destroy dialog)
      (connect dialog 'response on-dialog-response-close)
      (show dialog)
      (set! gl-i-counter (+ gl-i-counter 1))))


  (define-simple-method interactive-dialog-clicked
      (((window-parent <gtk-window>) (entry1 <gtk-entry>) (entry2 <gtk-entry>))
       <none> nonpure)
    (let ((dialog
	   (cast <gtk-dialog> (gtk-dialog-new)))
  	  (hbox (cast <gtk-box> (gtk-box-new 'horizontal 8)))
  	  (image-stock (gtk-image-new-from-icon-name
  			"dialog-question"))
  	  (grid (cast <gtk-grid> (gtk-grid-new)))
  	  (label1 (cast <gtk-label> (gtk-label-new "_Entry 1")))
  	  (entry-local1 (cast <gtk-entry> (gtk-entry-new)))
  	  (label2 (cast <gtk-label> (gtk-label-new "E_ntry 2")))
  	  (entry-local2 (cast <gtk-entry> (gtk-entry-new))))

      (set-title dialog "Interactive Dialog")
      
      (set-use-underline label1 #t)
      (set-use-underline label2 #t)

      (add-button dialog "Ok" 1)
      (add-button dialog "_Non-stock Button" 0)

      ;; (set-border-width hbox 8)
      (gtk-box-append (cast <gtk-box> (gtk-dialog-get-content-area dialog))
  		      hbox)

      (gtk-box-append hbox image-stock)

      (set-row-spacing grid 4)
      (set-column-spacing grid 4)
      (gtk-box-append hbox grid)

      (attach grid label1 0 0 1 1)
      (gtk-entry-buffer-set-text
       (gtk-entry-get-buffer entry-local1)
       (gtk-entry-buffer-get-text
	(gtk-entry-get-buffer entry1))
       -1)
      (attach grid entry-local1 1 0 1 1)
      (set-mnemonic-widget label1 entry-local1)

      (attach grid label2 0 1 1 1)
      (gtk-entry-buffer-set-text
       (gtk-entry-get-buffer entry-local2)
       (gtk-entry-buffer-get-text
	(gtk-entry-get-buffer entry2))
       -1)
      (attach grid entry-local2 1 1 1 1)
      (set-mnemonic-widget label2 entry-local2)

      (set-modal dialog #t)
      (set-transient-for dialog window-parent)

      (connect dialog 'response
	       (lambda (((args (rest <object>))) <object> nonpure)
		 (let ((i-response (uniform-list-ref args 1)))
		   (if (equal? i-response 1)
  		       (begin
			 (gtk-entry-buffer-set-text
			  (gtk-entry-get-buffer entry1)
			  (gtk-entry-buffer-get-text
			   (gtk-entry-get-buffer entry-local1))
			  -1)
			 (gtk-entry-buffer-set-text
			  (gtk-entry-get-buffer entry2)
			  (gtk-entry-buffer-get-text
			   (gtk-entry-get-buffer entry-local2))
			  -1))))
		 (gtk-window-destroy dialog)
		 null))
  
      (show dialog)))


  (define-simple-method run-dialog-demo (((window-parent <gtk-window>))
					 <none> nonpure)
    (let ((window (cast <gtk-window> (gtk-window-new)))
	  (frame (cast <gtk-frame> (gtk-frame-new "Dialogs")))
	  (vbox (cast <gtk-box> (gtk-box-new 'vertical 8))))
      (set-title window "Dialogs")
      ;; (set-border-width window 8)
      (set-child window frame)
      ;; (set-border-width vbox 8)
      (set-child frame vbox)

      ;; standard message dialog
      (let ((hbox (cast <gtk-box> (gtk-box-new 'horizontal 8)))
	    (button
	     (cast <gtk-button>
		   (gtk-button-new-with-label "_Message Dialog"))))
	(set-use-underline button #t)
	(gtk-box-append vbox hbox)
	(connect button 'clicked
		 (lambda (((args (rest <object>)))
			  <object>
			  nonpure)
		   (message-dialog-clicked window)
		   null))
	(gtk-box-append hbox button))
      (gtk-box-append vbox (gtk-separator-new 'horizontal))

      ;; interactive dialog
      (let ((hbox (cast <gtk-box> (gtk-box-new 'horizontal 8)))
	    (vbox2 (cast <gtk-box> (gtk-box-new 'vertical 0)))
	    (button
	     (cast <gtk-button>
		   (gtk-button-new-with-label "_Interactive Dialog")))
	    (grid (cast <gtk-grid> (gtk-grid-new)))
	    (label1 (cast <gtk-label> (gtk-label-new "_Entry 1")))
	    (entry1 (cast <gtk-entry> (gtk-entry-new)))
	    (label2 (cast <gtk-label> (gtk-label-new "E_ntry 2")))
	    (entry2 (cast <gtk-entry> (gtk-entry-new))))

	(set-use-underline button #t)
	(set-use-underline label1 #t)
	(set-use-underline label2 #t)
	(gtk-box-append vbox hbox)
	(connect
	 button 'clicked
	 (lambda (((args (rest <object>)))
		  <object>
		  nonpure)
	   (interactive-dialog-clicked window entry1 entry2)
	   null))

	(gtk-box-append hbox vbox2)
	(gtk-box-append vbox2 button)
	(set-row-spacing grid 4)
	(set-column-spacing grid 4)

	(gtk-box-append hbox grid)

	(attach grid label1 0 0 1 1)
	(attach grid entry1 1 0 1 1)
	(set-mnemonic-widget label1 entry1)
	(attach grid label2 0 1 1 1)
	(attach grid entry2 1 1 1 1)
	(set-mnemonic-widget label2 entry2)

	(set-modal window #t)
	(set-transient-for window window-parent)

	(show window))))


  (define-simple-method get-dialog-demo (() <demo> force-pure)
    (let* ((str-name "Dialog and Message Boxes")
	   (str-module-name "dialog")
	   (str-desc 
	    (string-append
	     "Dialog widgets are used to pop up a transient window "
	     "for user feedback."))
	   (demo (make <demo> str-name str-module-name str-desc "" ""
		       run-dialog-demo)))
      (demo-compute-source demo)
      demo)))
