aboutsummaryrefslogtreecommitdiff
path: root/internal.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-08-11 08:52:12 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-08-11 08:52:12 -0400
commite9dfc0a04d1bdb018ae77f1d914bf0e77f3370b6 (patch)
tree2e816aa6e65ece4ac5fee93ad70b0e2941b35bee /internal.f90
parent7b8f2ab32f66d8f3ce48a5e9685c05b25d31f2bb (diff)
downloadLR-87-e9dfc0a04d1bdb018ae77f1d914bf0e77f3370b6.tar.gz
LR-87-e9dfc0a04d1bdb018ae77f1d914bf0e77f3370b6.zip
Favorites and internal pages are now working. Added symbols to buttons in Windows based on new AppGraphics release.
Diffstat (limited to 'internal.f90')
-rw-r--r--internal.f90182
1 files changed, 182 insertions, 0 deletions
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