From e9dfc0a04d1bdb018ae77f1d914bf0e77f3370b6 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Tue, 11 Aug 2020 08:52:12 -0400 Subject: Favorites and internal pages are now working. Added symbols to buttons in Windows based on new AppGraphics release. --- ag_render.f90 | 46 +++++++++++--- favorites.f90 | 18 ++++-- files.f90 | 1 - gemini-windows.prj | 3 + internal.f90 | 182 +++++++++++++++++++++++++++++++++++++++++++++++++++++ main.F90 | 18 +++++- 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 @@ -55,6 +55,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 -- cgit v1.2.3