aboutsummaryrefslogtreecommitdiff
path: root/internal.F90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeffrey.armstrong@approximatrix.com>2020-09-25 10:58:13 -0400
committerJeffrey Armstrong <jeffrey.armstrong@approximatrix.com>2020-09-25 10:58:13 -0400
commite302c5cfcc30aa1b2e49ad5aa1fb524871618e43 (patch)
tree1643e697a4bb8d913dfc747e91de1405dc2ef827 /internal.F90
parente04bc46c5dfc33ed5d2f967a59176e3da0556904 (diff)
downloadLR-87-e302c5cfcc30aa1b2e49ad5aa1fb524871618e43.tar.gz
LR-87-e302c5cfcc30aa1b2e49ad5aa1fb524871618e43.zip
Added a homepage on Windows that showcases AppGraphics.
Diffstat (limited to 'internal.F90')
-rw-r--r--internal.F90272
1 files changed, 272 insertions, 0 deletions
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 <jeff@rainbow-100.com>
+!
+! 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