! This file is part of gtk-fortran, a GTK / Fortran interface library.
! Copyright (C) 2011 The gtk-fortran team
!
! This is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3, or (at your option)
! any later version.
!
! This software 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.
!
! Under Section 7 of GPL version 3, you are granted additional
! permissions described in the GCC Runtime Library Exception, version
! 3.1, as published by the Free Software Foundation.
!
! You should have received a copy of the GNU General Public License along with
! this program; see the files LICENSE and LICENSE_EXCEPTION respectively.
! If not, see <http://www.gnu.org/licenses/>.
!------------------------------------------------------------------------------
! Contributed by James Tappin
! Last modifications: 2012-12-31, vmagnin 2020-12-18
! https://developer.gnome.org/gtk4/stable/GtkDialog.html
!------------------------------------------------------------------------------
!*
! Dialog
module gtk_hl_dialog
  ! The message dialogue provided is here because, the built-in message
  ! dialogue GtkMessageDialog cannot be created without calling variadic
  ! functions which are not compatible with Fortran, therefore this is
  ! based around the plain GtkDialog family.
  !
  ! There are two functions provided, one; hl_gtk_message_dialog_new,
  ! just creates a dialogue and the other; hl_gtk_message_dialog_show,
  ! creates the dialogue and also displays it and returns the response.
  ! Unless you need to add other non-standard buttons to the dialogue
  ! it is easier to use  hl_gtk_message_dialog_show.
  !/

  use gtk_sup
  use, intrinsic :: iso_c_binding

  ! autogenerated use's
  use gtk, only: g_signal_connect, &
       & gtk_about_dialog_new, gtk_about_dialog_set_artists, &
       & gtk_about_dialog_set_authors, gtk_about_dialog_set_comments, &
       & gtk_about_dialog_set_copyright, gtk_about_dialog_set_documenters, &
       & gtk_about_dialog_set_license, gtk_about_dialog_set_program_name, &
       & gtk_about_dialog_set_translator_credits, &
       & gtk_about_dialog_set_logo, &
       & gtk_about_dialog_set_version, gtk_about_dialog_set_website, &
       & gtk_about_dialog_set_website_label, gtk_box_append, &
       & gtk_box_new, gtk_about_dialog_set_license_type, &
       & gtk_dialog_add_button, gtk_dialog_get_content_area, gtk_dialog_new, &
       & gtk_image_new_from_icon_name, gtk_label_new, &
       & gtk_label_set_markup, gtk_window_destroy, gtk_widget_show, &
       & gtk_window_set_destroy_with_parent, gtk_window_set_modal, &
       & gtk_window_set_title, gtk_window_set_transient_for, TRUE, &
       & GTK_RESPONSE_NONE, GTK_RESPONSE_OK, GTK_RESPONSE_CANCEL, &
       & GTK_RESPONSE_CLOSE, GTK_RESPONSE_YES, GTK_RESPONSE_NO, &
       & GTK_MESSAGE_INFO, GTK_MESSAGE_WARNING, &
       & GTK_MESSAGE_QUESTION, GTK_MESSAGE_ERROR, GTK_MESSAGE_OTHER, &
       & GTK_BUTTONS_NONE, GTK_BUTTONS_OK, GTK_BUTTONS_CLOSE, &
       & GTK_ORIENTATION_HORIZONTAL,  GTK_ORIENTATION_VERTICAL, &
       & GTK_LICENSE_GPL_3_0, &
       & GTK_BUTTONS_CANCEL, GTK_BUTTONS_YES_NO, GTK_BUTTONS_OK_CANCEL, &
       & GTK_RESPONSE_DELETE_EVENT, &
       & gtk_image_set_icon_size, GTK_ICON_SIZE_LARGE

  use g, only: g_main_loop_new, g_main_loop_run, g_main_loop_quit

  implicit none
  integer(c_int) :: dialog_response
  type(c_ptr) :: dialog_gmainloop

contains

  !+
  function hl_gtk_message_dialog_new(message, button_set, title, type, &
       & parent) result(dialog)

    type(c_ptr) :: dialog
    character(len=*), dimension(:), intent(in) :: message
    integer(c_int), intent(in) :: button_set
    character(kind=c_char), dimension(*), intent(in), optional :: title
    integer(c_int), intent(in), optional :: type
    type(c_ptr), intent(in), optional :: parent

    ! A DIY version of the message dialogue, needed because both creators
    ! for the built in one are variadic and so not callable from Fortran.
    !
    ! MESSAGE |  string(n) |  required |  The message to display. Since this is a string array, the C_NULL_CHAR terminations are provided internally
    ! BUTTON_SET |  integer |  required |  The set of buttons to display
    ! TITLE |  string |  optional |  Title for the window.
    ! TYPE |  c_int |  optional |  Message type (a GTK_MESSAGE_ value)
    ! PARENT |  c_ptr |  optional |  An optional parent for the dialogue.
    !-

    type(c_ptr) :: content, junk, hb, vb
    integer :: i
    integer(c_int) :: itype

    ! Create the dialog window and make it modal.

    dialog=gtk_dialog_new()
    call gtk_window_set_modal(dialog, TRUE)
    if (present(title)) call gtk_window_set_title(dialog, title)

    if (present(parent)) then
       call gtk_window_set_transient_for(dialog, parent)
       call gtk_window_set_destroy_with_parent(dialog, TRUE)
    end if

    ! Get the content area and put the message in it.
    content = gtk_dialog_get_content_area(dialog)
    if (present(type)) then
       itype = type
    else if (button_set == GTK_BUTTONS_YES_NO) then
       itype = GTK_MESSAGE_QUESTION
    else
       itype = GTK_MESSAGE_OTHER
    end if

    if (itype /= GTK_MESSAGE_OTHER) then
       hb = gtk_box_new(GTK_ORIENTATION_HORIZONTAL, 0_c_int)
       call gtk_box_append(content, hb)

       ! For the new icon names, replacing the GTK_STOCK, see:
       ! https://developer.gnome.org/gtk3/stable/gtk3-Stock-Items.html
       select case (itype)
       case (GTK_MESSAGE_ERROR)
          junk = gtk_image_new_from_icon_name("dialog-error"//c_null_char)
       case (GTK_MESSAGE_WARNING)
          junk = gtk_image_new_from_icon_name("dialog-warning"//c_null_char)
       case (GTK_MESSAGE_INFO)
          junk = gtk_image_new_from_icon_name("dialog-information"//c_null_char)
       case (GTK_MESSAGE_QUESTION)
          junk = gtk_image_new_from_icon_name("dialog-question"//c_null_char)
       case default
          junk=C_NULL_PTR
       end select

       if (c_associated(junk)) then
         call gtk_image_set_icon_size (junk, GTK_ICON_SIZE_LARGE)
         call gtk_box_append(hb, junk)
       end if

       vb = gtk_box_new(GTK_ORIENTATION_VERTICAL, 0_c_int)
       call gtk_box_append(hb, vb)
    else
       vb = content
    end if

    do i = 1, size(message)
       if (i == 1) then
          junk = gtk_label_new(c_null_char)
          call gtk_label_set_markup(junk, '<b><big>'//trim(message(i))// &
               & '</big></b>'//c_null_char)
       else
          junk = gtk_label_new(trim(message(i))//c_null_char)
       end if
       call gtk_box_append(vb, junk)
    end do

    select case (button_set)
    case (GTK_BUTTONS_NONE)
    case (GTK_BUTTONS_OK)
       junk = gtk_dialog_add_button(dialog, "_OK"//C_NULL_CHAR, GTK_RESPONSE_OK)
    case (GTK_BUTTONS_CLOSE)
       junk = gtk_dialog_add_button(dialog, "_Close"//C_NULL_CHAR, &
            & GTK_RESPONSE_CLOSE)
    case (GTK_BUTTONS_CANCEL)
       junk = gtk_dialog_add_button(dialog, "_Cancel"//C_NULL_CHAR, &
            & GTK_RESPONSE_CANCEL)
    case (GTK_BUTTONS_YES_NO)
       junk = gtk_dialog_add_button(dialog, "Yes"//C_NULL_CHAR, GTK_RESPONSE_YES)
       junk = gtk_dialog_add_button(dialog, "No"//C_NULL_CHAR, GTK_RESPONSE_NO)
    case (GTK_BUTTONS_OK_CANCEL)
       junk = gtk_dialog_add_button(dialog, "_OK"//C_NULL_CHAR, GTK_RESPONSE_OK)
       junk = gtk_dialog_add_button(dialog, "_Cancel"//C_NULL_CHAR, &
            & GTK_RESPONSE_CANCEL)
    case default
       call gtk_window_destroy(dialog)
       dialog = c_null_ptr

    end select

  end function hl_gtk_message_dialog_new

  !+
  function hl_gtk_message_dialog_show(message, button_set, title, type, &
       & parent) result(resp)

    integer(c_int) :: resp
    character(len=*), dimension(:), intent(in) :: message
    integer(c_int), intent(in) :: button_set
    character(kind=c_char), dimension(*), intent(in), optional :: title
    integer(c_int), intent(in), optional :: type
    type(c_ptr), intent(in), optional :: parent

    ! A DIY version of the message dialogue, needed because both creators
    ! for the built in one are variadic and so not callable from Fortran.
    ! This version runs the dialog as well as creating it.
    !
    ! MESSAGE |  string(n) |  required |  The message to display. Since this is a string array, the C_NULL_CHAR terminations are provided internally
    ! BUTTON_SET |  integer |  required |  The set of buttons to display
    ! TITLE |  string |  optional |  Title for the window.
    ! TYPE |  c_int |  optional |  Message type (a GTK_MESSAGE_ value)
    ! PARENT |  c_ptr |  optional |  An optional parent for the dialogue.
    !
    ! This version returns a response code, not a widget pointer.
    !-

    type(c_ptr) :: dialog

    dialog = hl_gtk_message_dialog_new(message, button_set, title, type, &
         & parent)

    if (c_associated(dialog)) then
       call gtk_widget_show(dialog)
       call g_signal_connect(dialog, "response"//c_null_char, &
                                    & c_funloc(dialog_callback))
       dialog_gmainloop = g_main_loop_new(c_null_ptr, FALSE)
       call g_main_loop_run(dialog_gmainloop)
       resp = dialog_response
    else
       resp = GTK_RESPONSE_NONE
    end if
  end function hl_gtk_message_dialog_show

! https://developer.gnome.org/gtk4/stable/GtkDialog.html#GtkDialog-response
  subroutine dialog_callback(dialog, response_id, user_data) bind(c)
    type(c_ptr), value, intent(in) :: dialog, user_data
    integer(c_int), value, intent(in) :: response_id

    ! Global variable:
    dialog_response = response_id

    call gtk_window_destroy(dialog)
    call g_main_loop_quit(dialog_gmainloop)
  end subroutine dialog_callback

  !+
  function hl_gtk_about_dialog_new(name, license, license_type, &
       & comments, authors, website, website_label, copyright, version, &
       & documenters, translators, artists, logo, parent) result(about)
    type(c_ptr) :: about
    character(kind=c_char, len=*), intent(in), optional :: name
    character(kind=c_char, len=*), intent(in), optional :: license
    integer(c_int), intent(in), optional :: license_type
    character(kind=c_char, len=*), intent(in), optional :: comments
    character(len=*, kind=c_char), dimension(:), optional, target :: authors, &
         & documenters, artists
    character(kind=c_char, len=*), intent(in), optional :: website, &
         & website_label, translators, copyright, version
    type(c_ptr), intent(in), optional :: logo, parent

    ! A convenience interface for about dialogues.
    !
    ! NAME |  string |  optional |  The name of the program etc.
    ! LICENCE |  string |  optional |  The license for the program.
    ! LICENCE_TYPE |  c_int |  optional |  Specify a license from the GtkLicence enumerator. (Only valid in  GTK 3.0 and later)
    ! COMMENTS |  string |  optional |  A description of the program/library...
    ! AUTHORS |  string() |  optional |  A list of the authors.
    ! WEBSITE |  string |  optional |  The website.
    ! WEBSITE_LABEL |  string |  optional |  A label to describe the website.
    ! COPYRIGHT |  string |  optional |  The copyright message.
    ! VERSION |  string |  optional |  The version of the program.
    ! DOCUMENTERS |  string() |  optional |  The documentation authors.
    ! TRANSLATORS |  string |  optional |  The translators (N.B. unlike the other credits, this is a single string).
    ! ARTISTS |  string() |  optional |  The artists involved.
    ! LOGO |  c_ptr |  optional |  A gdk_pixbuf with the project's logo.
    ! PARENT |  c_ptr |  optional |  The parent widget of the window.
    !-

    character(kind=c_char), dimension(:), allocatable :: string
    character(kind=c_char), pointer, dimension(:) :: credit
    type(c_ptr), dimension(:), allocatable :: cptr
    integer :: i

    about = gtk_about_dialog_new()
    call gtk_window_set_modal(about, TRUE)
    if (present(parent)) call gtk_window_set_transient_for(about, parent)

    if (present(logo)) call gtk_about_dialog_set_logo(about, logo)

    if (present(name)) then
       call f_c_string(name, string)
       call gtk_about_dialog_set_program_name(about, string)
       deallocate(string)
    end if

    if (present(license)) then
       call f_c_string(license, string)
       call gtk_about_dialog_set_license(about, string)
       deallocate(string)
    else if (present(license_type)) then
       call gtk_about_dialog_set_license_type(about, license_type)
    end if

    if (present(comments)) then
       call f_c_string(comments, string)
       call gtk_about_dialog_set_comments(about, string)
       deallocate(string)
    end if
    if (present(website)) then
       call f_c_string(website, string)
       call gtk_about_dialog_set_website(about, string)
       deallocate(string)
    end if
    if (present(website_label)) then
       call f_c_string(website_label, string)
       call gtk_about_dialog_set_website_label(about, string)
       deallocate(string)
    end if
    if (present(translators)) then
       call f_c_string(translators, string)
       call gtk_about_dialog_set_translator_credits(about, string)
       deallocate(string)
    end if
    if (present(copyright)) then
       call f_c_string(copyright, string)
       call gtk_about_dialog_set_copyright(about, string)
       deallocate(string)
    end if
    if (present(version)) then
       call f_c_string(version, string)
       call gtk_about_dialog_set_version(about, string)
       deallocate(string)
    end if

    if (present(authors)) then
       allocate(cptr(size(authors)+1))
       do i = 1, size(authors)
          call f_c_string(authors(i), string)
          allocate(credit(size(string)))
          credit(:) = string(:)
          cptr(i) = c_loc(credit(1))
          nullify(credit)
       end do
       cptr(size(authors)+1) = c_null_ptr
       call gtk_about_dialog_set_authors(about, cptr)
       deallocate(cptr)
    end if
    if (present(documenters)) then
       allocate(cptr(size(documenters)+1))
       do i = 1, size(documenters)
          call f_c_string(documenters(i), string)
          allocate(credit(size(string)))
          credit(:) = string(:)
          cptr(i) = c_loc(credit(1))
          nullify(credit)
       end do
       cptr(size(documenters)+1) = c_null_ptr
       call gtk_about_dialog_set_documenters(about, cptr)
       deallocate(cptr)
    end if
    if (present(artists)) then
       allocate(cptr(size(artists)+1))
       do i = 1, size(artists)
          call f_c_string(artists(i), string)
          allocate(credit(size(string)))
          credit(:) = string(:)
          cptr(i) = c_loc(credit(1))
          nullify(credit)
       end do
       cptr(size(artists)+1) = c_null_ptr
       call gtk_about_dialog_set_artists(about, cptr)
       deallocate(cptr)
    end if

  end function hl_gtk_about_dialog_new

  subroutine hl_gtk_about_dialog_show(name, license, license_type, &
       & comments, authors, website, website_label, copyright, version, &
       & documenters, translators, artists, logo, parent)

    character(kind=c_char, len=*), intent(in), optional :: name
    character(kind=c_char, len=*), intent(in), optional :: license
    integer(c_int), intent(in), optional :: license_type
    character(kind=c_char, len=*), intent(in), optional :: comments
    character(len=*, kind=c_char), dimension(:), optional, target :: authors, &
         & documenters, artists
    character(kind=c_char, len=*), intent(in), optional :: website, &
         & website_label, translators, copyright, version
    type(c_ptr), intent(in), optional :: logo, parent

    ! A convenience interface for about dialogues, displays the dialogue
    ! as well as creating it.
    ! The arguments are identical to hl_gtk_about_dialog_new.
    !-

    type(c_ptr) :: about

    about = hl_gtk_about_dialog_new(name, license, license_type, &
         & comments, authors, website, website_label, copyright, version, &
         & documenters, translators, artists, logo, parent)

    call gtk_widget_show(about)
    call g_signal_connect(about, "close-request"//c_null_char, &
                                    & c_funloc(dialog_callback))
    dialog_gmainloop = g_main_loop_new(c_null_ptr, FALSE)
    call g_main_loop_run(dialog_gmainloop)
  end subroutine hl_gtk_about_dialog_show

  !+
  subroutine hl_gtk_about_dialog_gtk_fortran(parent)
    type(c_ptr), intent(in), optional :: parent

    ! A standard "About" dialogue for gtk-fortran
    !
    ! PARENT |  c_ptr |  optional |  A parent widget for the dialogue.
    !-

    call hl_gtk_about_dialog_show(name="Gtk-fortran", &
         & authors = [character(len=14) :: "Jerry DeLisle", &
         & "Vincent Magnin", "James Tappin", "Jens Hunger", "Kyle Horne"], &
         & license_type=GTK_LICENSE_GPL_3_0, &
         & comments = &
         &"The gtk-fortran project aims to offer scientists programming "//&
         &"in Fortran a cross-platform library to build Graphical User "//&
         &"Interfaces (GUI)."//c_new_line// &
         &"Gtk-fortran is a partial GTK / Fortran binding 100% written "//&
         &"in Fortran, thanks to the ISO_C_BINDING module for "//&
         &"interoperability between C and Fortran, which is a part of the "//&
         &"Fortran 2003 standard. Gtk-Fortran also provides a number of "//&
         &"'high-level' interfaces to common widgets."//&
         &c_new_line//c_new_line// &
         &"GTK is a free software cross-platform graphical library "//&
         &"available for Linux, Unix, Windows and MacOs X."//C_NULL_CHAR, &
         & website="https://github.com/jerryd/gtk-fortran/wiki"//C_NULL_CHAR,&
         & parent=parent)

  end subroutine hl_gtk_about_dialog_gtk_fortran
end module gtk_hl_dialog
