From e302c5cfcc30aa1b2e49ad5aa1fb524871618e43 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Fri, 25 Sep 2020 10:58:13 -0400 Subject: Added a homepage on Windows that showcases AppGraphics. --- internal.F90 | 272 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 272 insertions(+) create mode 100644 internal.F90 (limited to 'internal.F90') diff --git a/internal.F90 b/internal.F90 new file mode 100644 index 0000000..5ef2c5d --- /dev/null +++ b/internal.F90 @@ -0,0 +1,272 @@ +! Copyright (c) 2020 Jeffrey Armstrong +! +! 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: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! The Software shall be used for Good, not Evil. +! +! 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. + +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. +#ifdef WINDOWS + else if(index(requested_operation, "home") == 1) then + call handle_home(unit_number) + handle_internal_url = .true. +#endif + 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)) + +#ifdef WINDOWS + write(unit_number, *) + call write_no_space(unit_number, "=> lr87://home Start Page") +#endif + + 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 + + subroutine handle_home(unit_number) + implicit none + + integer, intent(in)::unit_number + + call write_nonsense_status(unit_number) + + call write_no_space(unit_number, "# A Gemini Browser Written in Simply Fortran") + + write(unit_number, *) + + call write_no_space(unit_number, "LR-87 is a browser for the Gemini protocol, which is similar to the World Wide "// & + "Web, only smaller and simpler. This browser implements the much of the Gemini "// & + "protocol, including browsing and user input. On Microsoft Windows, the LR-87 "// & + "browser uses Simply Fortran's AppGraphics package for all rendering.") + + write(unit_number, *) + + call write_no_space(unit_number, "Simply Fortran is a full-featured integrated development environment for the "// & + "Fortran programming language. It includes a complete, pre-configured Fortran " // & + "compiler and tool suite in addition to the development environment, meaning there "// & + "is nothing else for the user to configure and install. Included with the package "// & + "is the AppGraphics library, which enables the creation of full-featured graphical "// & + "user interfaces written entirely in Fortran. If you'd like to learn more about "// & + "Simply Fortran, click the link below (which will open a web browser):") + + write(unit_number, *) + + call write_no_space(unit_number, "=> https://simplyfortran.com/?platform=windows Simply Fortran Home Page") + + write(unit_number, *) + + call write_no_space(unit_number, "## Sites to See in Gemini Space") + + write(unit_number, *) + + call write_no_space(unit_number, "=> gemini://gus.guru/ Gemini Universal Search - search all sites in Gemini") + + call write_no_space(unit_number, "=> gemini://rawtext.club:1965/~sloum/spacewalk.gmi Spacewalk - "// & + "a list of recently updated Gemini sites") + + call write_no_space(unit_number, "=> gemini://rainbow-100.com/software/lr87.gmi LR-87 Site - "// & + "the primary home of the LR-87 browser") + + call write_no_space(unit_number, "=> gemini://gemini.circumlunar.space/ More About the Gemini Protocol") + + call write_no_space(unit_number, "=> lr87://about More About the LR-87 Gemini browser") + + + end subroutine handle_home + +end module internal_links \ No newline at end of file -- cgit v1.2.3