! 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