aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ag_render.f9046
-rw-r--r--favorites.f9018
-rw-r--r--files.f901
-rw-r--r--gemini-windows.prj3
-rw-r--r--internal.f90182
-rw-r--r--main.F9018
6 files changed, 254 insertions, 14 deletions
diff --git a/ag_render.f90 b/ag_render.f90
index 18f4014..211c718 100644
--- a/ag_render.f90
+++ b/ag_render.f90
@@ -44,6 +44,7 @@ implicit none
integer, parameter::ag_render_event_resize = 6
integer, parameter::ag_render_event_mousemove = 7
integer, parameter::ag_render_event_favorite = 8
+ integer, parameter::ag_render_event_internal = 9
type :: link
integer, dimension(4)::location
@@ -57,6 +58,7 @@ implicit none
integer::go_button_id
integer::back_button_id
integer::fave_button_id
+ integer::internal_button_id
integer::scroll_id
integer::font_size
@@ -164,6 +166,16 @@ contains
end subroutine fave_button_callback
+ subroutine internal_button_callback()
+ use appgraphics, only: stopidle
+ implicit none
+
+ ag_render_event = ag_render_event_internal
+ call stopidle()
+
+ end subroutine internal_button_callback
+
+
subroutine mouse_button_callback(x, y)
use appgraphics, only: stopidle
implicit none
@@ -243,12 +255,12 @@ contains
call setfillstyle(SOLID_FILL, LIGHTGRAY)
call setbkcolor(LIGHTGRAY)
call setcolor(BLACK)
- call settextstyle(WINDOWS_FONT, HORIZ_DIR, 12)
+ call settextstyle(SYMBOLS_FONT, HORIZ_DIR, 14)
! Draw the buttons first
- x = getmaxx()/4 - 40
+ x = 5
if(self%back_button_id < 0) then
- self%back_button_id = createbutton(x, 2, 40, 20, "Back", back_button_callback)
+ self%back_button_id = createbutton(x, 2, 40, 20, CHAR(231), back_button_callback)
else
call setbuttonposition(self%back_button_id, x, 2, 40, 20)
end if
@@ -256,6 +268,7 @@ contains
x = x + 50
label_x = x
+ call settextstyle(WINDOWS_FONT, HORIZ_DIR, 12)
x = x + textwidth("Address:") + 5
address_width = getmaxx()/2 - textwidth("Address:") - 5
if(self%address_id < 0) then
@@ -268,26 +281,39 @@ contains
! Clears any drawing operations for controls quickly
ignored = switch_to_thread()
+ call settextstyle(SYMBOLS_FONT, HORIZ_DIR, 14)
+
x = x + 10 + address_width
if(self%go_button_id < 0) then
- self%go_button_id = createbutton(x, 2, 40, 20, "Go!", go_button_callback)
+ self%go_button_id = createbutton(x, 2, 40, 20, CHAR(232), go_button_callback)
else
call setbuttonposition(self%go_button_id, x, 2, 40, 20)
end if
- x = x + 50
+ call settextstyle(SYMBOLS_FONT, HORIZ_DIR, 18)
+ x = getmaxx() - 95
if(self%fave_button_id < 0) then
- self%fave_button_id = createbutton(x, 2, 40, 20, "Wow!", fave_button_callback)
+ self%fave_button_id = createbutton(x, 2, 40, 20, CHAR(171), fave_button_callback)
else
call setbuttonposition(self%fave_button_id, x, 2, 40, 20)
end if
+ x = x + 50
+ if(self%internal_button_id < 0) then
+ self%internal_button_id = createbutton(x, 2, 40, 20, CHAR(62), internal_button_callback)
+ else
+ call setbuttonposition(self%internal_button_id, x, 2, 40, 20)
+ end if
+
! Clears any drawing operations for controls quickly
ignored = switch_to_thread()
call setviewport(0, 0, getmaxx()+1, self%address_bar_height+1, .true.)
call clearviewport()
+
+ call settextstyle(WINDOWS_FONT, HORIZ_DIR, 12)
call outtextxy(label_x, 5, "Address:")
+
call resetviewport()
end subroutine draw_address_bar
@@ -376,6 +402,7 @@ contains
self%go_button_id = -1
self%back_button_id = -1
self%fave_button_id = -1
+ self%internal_button_id = -1
self%scroll_id = -1
call draw_address_bar(self)
@@ -827,6 +854,10 @@ contains
case(ag_render_event_favorite)
ag_action = render_action_favorite
+
+ case(ag_render_event_internal)
+ text = "lr87://menu"
+ ag_action = render_action_goto
end select
@@ -856,6 +887,7 @@ contains
subroutine ag_report_page(self, text)
use appgraphics
+ use internal_links, only: internal_url
implicit none
class(appgraphics_renderer)::self
@@ -863,7 +895,7 @@ contains
call set_window_title(self, text)
- if(index(text, "gemini://") > 0) then
+ if(index(text, "gemini://") > 0 .or. index(text, internal_url) > 0) then
call settextboxcontents(self%address_id, trim(text))
end if
diff --git a/favorites.f90 b/favorites.f90
index a1e0a6b..90cd2d1 100644
--- a/favorites.f90
+++ b/favorites.f90
@@ -60,9 +60,9 @@ contains
res = 1
do i = 2, size(array)
- if(mymin .and. string_compare(array(res), array(i)) < 0) then
+ if(mymin .and. string_compare(array(res), array(i)) > 0) then
res = i
- else if((.not. mymin) .and. string_compare(array(res), array(i)) > 0) then
+ else if((.not. mymin) .and. string_compare(array(res), array(i)) < 0) then
res = i
end if
end do
@@ -230,17 +230,25 @@ contains
end subroutine write_favorite
- subroutine write_favorites(unit_number, faves)
+ subroutine write_favorites(unit_number, faves, skip_heading)
implicit none
integer, intent(in)::unit_number
type(favorite), dimension(:), intent(in)::faves
+ logical, intent(in), optional::skip_heading
integer::i
character(8)::n_text
- write(unit_number, '(A11)') "# Favorites"
- write(unit_number, *)
+ if(present(skip_heading)) then
+ if(.not. skip_heading) then
+ write(unit_number, '(A11)') "# Favorites"
+ write(unit_number, *)
+ end if
+ else
+ write(unit_number, '(A11)') "# Favorites"
+ write(unit_number, *)
+ end if
write(n_text, '(I8)') size(faves)
diff --git a/files.f90 b/files.f90
index b1c24dc..1c76311 100644
--- a/files.f90
+++ b/files.f90
@@ -82,7 +82,6 @@ contains
end do
length = (endpos - startpos + 1)
- !print '(A10, I8)', "allocated", length
allocate(character(len=length) :: res)
res = repeat(' ', length)
diff --git a/gemini-windows.prj b/gemini-windows.prj
index e7141c5..ec16f2b 100644
--- a/gemini-windows.prj
+++ b/gemini-windows.prj
@@ -56,6 +56,9 @@
"filename":".\\history.f90",
"enabled":"1"
},{
+ "filename":".\\internal.f90",
+ "enabled":"1"
+ },{
"filename":".\\layout.f90",
"enabled":"1"
},{
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
diff --git a/main.F90 b/main.F90
index d06131b..9af9708 100644
--- a/main.F90
+++ b/main.F90
@@ -39,6 +39,8 @@ use layout
use file_handling
use history
+use internal_links, only: handle_internal_url, internal_url
+
#ifdef WINDOWS
use wsa_network, only: windows_network_startup => startup
#endif
@@ -117,12 +119,26 @@ implicit none
open(unit=io, form="formatted", status="scratch", access='stream')
do while(running)
+
+ ! Check for an internal url first
+ if(index(desired_url, internal_url) == 1) then
+
+ if(handle_internal_url(desired_url, io, faves)) then
+ populated = .true.
+ loaded = .true.
+ return_code = STATUS_SUCCESS
+ return_type = "text/gemini"
+
+ call update_status(r, desired_url, return_code)
+ end if
+
+ else if(index(desired_url, "gemini://") /= 1) then
- if(index(desired_url, "gemini://") /= 1) then
redo_layout = r%report_unsupported_protocol(trim(desired_url))
populated = .false.
loaded = .true.
return_code = STATUS_PROTOCOLFAIL
+
end if
if(.not. loaded) then