From e9dfc0a04d1bdb018ae77f1d914bf0e77f3370b6 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Tue, 11 Aug 2020 08:52:12 -0400 Subject: Favorites and internal pages are now working. Added symbols to buttons in Windows based on new AppGraphics release. --- internal.f90 | 182 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 182 insertions(+) (limited to 'internal.f90') diff --git a/internal.f90 b/internal.f90 index 9062837..7ba5b4e 100644 --- a/internal.f90 +++ b/internal.f90 @@ -1,8 +1,190 @@ module internal_links implicit none + private + public::internal_url, handle_internal_url + + character(*), parameter::internal_url = "lr87://" + + contains + function handle_internal_url(url, unit_number, faves) + use favorite_handling + implicit none + + character(*), intent(in)::url + integer, intent(in)::unit_number + type(favorite), dimension(:), pointer, intent(inout)::faves + + logical::handle_internal_url + character(80)::requested_operation + + handle_internal_url = .false. + + requested_operation = url(len(internal_url)+1:len_trim(url)) + + if(trim(requested_operation) == "menu") then + call handle_menu(unit_number) + handle_internal_url = .true. + else if(trim(requested_operation) == "about") then + call handle_about(unit_number) + handle_internal_url = .true. + else if(index(requested_operation, "favorites") == 1) then + call handle_favorites(unit_number, trim(requested_operation), faves) + handle_internal_url = .true. + end if + + end function handle_internal_url + + subroutine write_no_space(unit_number, string) + implicit none + + character(*), intent(in)::string + integer, intent(in)::unit_number + character(10)::f + integer::string_length + + string_length = len_trim(string) + if(string_length < 10) then + write(f, "(A2,I1,A1)") '(A', string_length,')' + else if(string_length < 100) then + write(f, "(A2,I2,A1)") '(A', string_length,')' + else + write(f, "(A2,I3,A1)") '(A', string_length,')' + end if + + write(unit_number, f) string + + end subroutine write_no_space + + subroutine write_nonsense_status(unit_number) + implicit none + + integer, intent(in)::unit_number + + rewind(unit_number) + + write(unit_number, '(I2, 1X, A11)') 20, "text/gemini" + write(unit_number, *) + + end subroutine write_nonsense_status + + subroutine write_header(unit_number, title) + implicit none + character(*), intent(in)::title + integer, intent(in)::unit_number + + call write_nonsense_status(unit_number) + + call write_no_space(unit_number, "# "//trim(title)) + + write(unit_number, *) + + call write_no_space(unit_number, "=> lr87://favorites/date/newest Favorites Sorted by Date (Newest First)") + call write_no_space(unit_number, "=> lr87://favorites/date/oldest Favorites Sorted by Date (Oldest First)") + call write_no_space(unit_number, "=> lr87://favorites/alpha/ascending Favorites Sorted Alphabetically Ascending") + call write_no_space(unit_number, "=> lr87://favorites/alpha/descending Favorites Sorted Alphabetically Descending") + write(unit_number, *) + + call write_no_space(unit_number, "=> lr87://about About LR-87") + + write(unit_number, *) + + end subroutine write_header + + subroutine handle_menu(unit_number) + implicit none + + integer, intent(in)::unit_number + + call write_header(unit_number, "Main Menu") + + end subroutine handle_menu + + subroutine handle_about(unit_number) + use file_handling, only: end_indicator + implicit none + + integer, intent(in)::unit_number + + call write_header(unit_number, "About") + + call write_no_space(unit_number, "## LR-87 - A Gemini Browser Written in Fortran") + call write_no_space(unit_number, "Copyright 2020 Jeffrey Armstrong") + call write_no_space(unit_number, "=> http://git.rainbow-100.com/cgit.cgi/LR-87/about/ LR-87 Web Home Page") + call write_no_space(unit_number, "=> gemini://rainbow-100.com/software/lr87.gmi LR-87 Gemini Home Page") + + write(unit_number, *) + + call write_no_space(unit_number, "LR-87 uses the following technologies:") + write(unit_number, *) + call write_no_space(unit_number, "* OpenSSL from The OpenSSL Project") + call write_no_space(unit_number, "* AppGraphics from Approximatrix, LLC on Windows") + + write(unit_number, *) + + call write_no_space(unit_number, "### License") + call write_no_space(unit_number, "Permission is hereby granted, free of charge, to any "//& + "person obtaining a copy of this software and associated "//& + 'documentation files (the "Software"), to deal in the '//& + "Software without restriction, including without limitation "//& + "the rights to use, copy, modify, merge, publish, distribute, "//& + "sublicense, and/or sell copies of the Software, and to "//& + "permit persons to whom the Software is furnished to do so, "//& + "subject to the following conditions:") + write(unit_number, *) + call write_no_space(unit_number, "The above copyright notice and this permission notice shall "//& + "be included in all copies or substantial portions of the Software.") + write(unit_number, *) + call write_no_space(unit_number, "The Software shall be used for Good, not Evil.") + write(unit_number, *) + call write_no_space(unit_number, 'THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, '//& + "EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES "//& + "OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND "//& + "NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT "//& + "HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, "//& + "WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING "//& + "FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR "//& + "OTHER DEALINGS IN THE SOFTWARE. ") + write(unit_number, *) + call write_no_space(unit_number, end_indicator) + + end subroutine handle_about + + subroutine handle_favorites(unit_number, op, faves) + use favorite_handling + use file_handling, only: end_indicator + implicit none + + character(*), intent(in)::op + integer, intent(in)::unit_number + type(favorite), dimension(:), pointer, intent(inout)::faves + + call write_header(unit_number, "Favorites") + + if(.not. associated(faves)) then + call write_no_space(unit_number, "You currently have no favorites saved.") + + ! Alpha sort + else + if(index(op, "alpha") > 1) then + call sort_alpha(faves, index(op, "descending") > 1) + + ! Date sort + else + call sort_added(faves, index(op, "latest") > 1) + + end if + + call write_favorites(unit_number, faves, skip_heading=.true.) + + end if + + call write_no_space(unit_number, end_indicator) + + end subroutine handle_favorites + end module internal_links \ No newline at end of file -- cgit v1.2.3