From 0ade9914918238b8da35e995fe9782a517988ae2 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Tue, 5 May 2020 11:04:22 -0400
Subject: Fixed link handling.  Can now navigate links and page up/down.

---
 dumb_render.f90 | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++++---
 layout.f90      | 25 ++++++++++++++++++
 main.F90        | 34 ++++++++++++++++++------
 protocol.f90    | 32 +++++++++++++++++++++-
 render.f90      | 27 ++++++++++++++++++-
 5 files changed, 186 insertions(+), 14 deletions(-)

diff --git a/dumb_render.f90 b/dumb_render.f90
index 3980245..9172557 100644
--- a/dumb_render.f90
+++ b/dumb_render.f90
@@ -10,9 +10,12 @@ implicit none
         integer::link_index
         character(len=1024), dimension(height)::link_urls
 
+        integer::first_line
+
     contains
 
         procedure :: initialize => dumb_initialize
+        procedure :: new_page => dumb_new_page
         procedure :: prepare_for_layout => prepare_for_dumb_layout
     
         procedure :: text_width => dumb_text_width
@@ -38,6 +41,8 @@ implicit none
         procedure :: draw_error => dumb_draw_error
         
         procedure :: report_status => dumb_draw_status
+        
+        procedure :: request_action => dumb_action
     
     end type dumb_renderer
     
@@ -50,11 +55,22 @@ contains
         
         self%max_width = width
         self%y = 0
+        self%first_line = 1
         
         self%link_index = 0
         self%link_urls = " "
         
     end subroutine dumb_initialize
+    
+    subroutine dumb_new_page(self)
+    implicit none
+    
+        class(dumb_renderer)::self
+        
+        self%y = 0
+        self%first_line = 1
+        
+    end subroutine dumb_new_page
 
     subroutine prepare_for_dumb_layout(self)
     implicit none
@@ -64,9 +80,8 @@ contains
         self%link_index = 0
         self%link_urls = " "
         
-        ! Write a page feed to clear the screen (not really necessary, but...)
-        write(*, '(A1)', advance='no') char(12)
-        
+        self%y = 0
+
     end subroutine prepare_for_dumb_layout
 
     function store_link(self, url)
@@ -111,8 +126,10 @@ contains
         class(dumb_renderer)::self
         character(*), intent(in)::text
         logical::dumb_text_visible
+        integer::onscreen
         
-        dumb_text_visible = (self%y >= 0 .AND. self%y < 24)
+        onscreen = self%y-self%first_line+1
+        dumb_text_visible = (onscreen >= 0 .AND. onscreen < 24)
     
     end function dumb_text_visible
     
@@ -236,4 +253,61 @@ contains
         
     end subroutine dumb_draw_status
     
+    subroutine prompt_user(input)
+    implicit none
+    
+        character(*), intent(out)::input
+    
+        write(*, '(A68)', advance='no') "*** [A] PgUp  |  [Z] PgDn  |  [#] Link  |  [U] URL  |  [Q] Quit => "
+        read(*, *) input
+        
+    end subroutine prompt_user
+    
+    function dumb_action(self, text)
+    use render, only: render_action_none, render_action_layout, &
+                      render_action_goto, render_action_quit
+    implicit none
+    
+        class(dumb_renderer)::self
+        character(*), intent(out)::text
+        integer::dumb_action
+        
+        character(256)::input
+        integer::link_id, iostatus
+        
+        call prompt_user(input)
+        
+        if(len_trim(input) == 0) then
+            dumb_action = render_action_none
+        else if(trim(input) == "a" .or. trim(input) == "A") then
+            self%first_line = max(self%first_line - 24, 0)
+            dumb_action = render_action_layout
+        else if(trim(input) == "z" .or. trim(input) == "Z") then
+            self%first_line = self%first_line + 24
+            dumb_action = render_action_layout
+        else if(trim(input) == "q" .or. trim(input) == "Q") then
+            dumb_action = render_action_quit
+        else if(trim(input) == "u" .or. trim(input) == "U") then
+            write(*, '(A5)', advance='no') "URL: "
+            read(*,'(A75)') text
+            if(len_trim(text) == 0) then
+                dumb_action = render_action_layout
+            else
+                dumb_action = render_action_goto
+            end if
+        else
+            read(input, '(I3)', iostat=iostatus) link_id
+            if(iostatus == 0 .and. link_id >= 1 .and. link_id <= self%link_index) then
+                text = self%link_urls(link_id)
+                dumb_action = render_action_goto
+            else
+                Print *, "Error in command: "//trim(input)
+                dumb_action = render_action_none
+            end if
+        end if
+        
+        
+    end function dumb_action
+    
+    
 end module dumb_render
\ No newline at end of file
diff --git a/layout.f90 b/layout.f90
index 1c7d8cb..9a3797b 100644
--- a/layout.f90
+++ b/layout.f90
@@ -53,4 +53,29 @@ contains
     
     end subroutine layout_lines
 
+    subroutine free_lines(first_line)
+    implicit none
+    
+        type(line), intent(inout), pointer::first_line
+        
+        type(line), pointer::walker, past
+        
+        walker => first_line
+        
+        do while(associated(walker))
+            if(allocated(walker%text)) then
+                deallocate(walker%text)
+            end if
+            
+            past => walker
+            walker => walker%next
+            
+            deallocate(past)
+            
+        end do
+        
+        first_line => null()
+        
+    end subroutine free_lines
+
 end module layout
\ No newline at end of file
diff --git a/main.F90 b/main.F90
index cb9e8b1..9ab1782 100644
--- a/main.F90
+++ b/main.F90
@@ -12,7 +12,7 @@ use wsa_network, only: windows_network_startup => startup
 implicit none
 
     character(256)::initial_site
-    character(1024)::current_url
+    character(1024)::current_url, input
     type(connection)::conn
     type(dumb_renderer)::r
     
@@ -70,8 +70,6 @@ implicit none
             
             call update_status(r, current_url, return_code)
             
-            loaded = .true.
-            
         end if
     
         if(return_code == STATUS_REDIRECT) then 
@@ -82,17 +80,37 @@ implicit none
         else
         
             first_line => load_unit(io, file_type_gemini)
-        
+            loaded = .true.
+            call r%new_page()
             call r%report_status("Performing Layout")
             call layout_lines(first_line, r)
     
         end if
         
+        do while(loaded .and. running)
         
-        running = .not. loaded
-    
-    
-    
+            select case(r%request_action(input))
+                case (render_action_quit)
+                    running = .false.
+                    
+                case (render_action_layout)
+                    call r%report_status("Performing Layout")
+                    call layout_lines(first_line, r)
+                    
+                case (render_action_goto)
+                
+                    if(index(input, "://") > 0) then
+                        current_url = input
+                    else
+                        call handle_relative_url(current_url, input)
+                    end if
+                    
+                    call free_lines(first_line)
+                    loaded = .false.
+        
+            end select
+            
+        end do        
     end do
     
     close(io)
diff --git a/protocol.f90 b/protocol.f90
index 52b6430..130c866 100644
--- a/protocol.f90
+++ b/protocol.f90
@@ -48,7 +48,6 @@ contains
             if(send_string(conn%ssl, url//c_carriage_return//c_new_line, trimming=.false.)) then
                 
                 bytes_received = retrieve_characters(conn%ssl, buffer)
-                Print *, bytes_received
                 do while(bytes_received > 0)
                 
                     do i=1, bytes_received
@@ -115,4 +114,35 @@ contains
         
     end subroutine get_redirect_url
 
+    subroutine handle_relative_url(current_url, path)
+    implicit none
+    
+        character(*), intent(inout)::current_url
+        character(*), intent(in)::path
+        
+        integer::past_protocol, first_slash, last_slash
+        
+        past_protocol = index(current_url, "://")
+        if(past_protocol > 0) then
+            
+            past_protocol = past_protocol + 3
+            
+            if(path(1:1) == "/") then
+            
+                first_slash = index(current_url(past_protocol:len_trim(current_url)), "/")
+                current_url = current_url(1:(past_protocol + first_slash - 1))//path
+                
+            else
+            
+                last_slash = index(current_url, "/", back=.true.)
+                if(last_slash > 0) then
+                    current_url = current_url(1:last_slash)//path
+                end if
+                
+            end if
+            
+        end if
+
+    end subroutine handle_relative_url
+
 end module gemini_protocol
\ No newline at end of file
diff --git a/render.f90 b/render.f90
index 6f285f7..b3b1c32 100644
--- a/render.f90
+++ b/render.f90
@@ -1,6 +1,11 @@
 module render
 implicit none
 
+    integer, parameter::render_action_none   = 1
+    integer, parameter::render_action_goto   = 2
+    integer, parameter::render_action_layout = 3
+    integer, parameter::render_action_quit   = 4
+
     type, abstract :: renderer
     
         integer::y
@@ -12,6 +17,7 @@ implicit none
         
         procedure(initialize), deferred::initialize
         procedure(prepare_for_layout), deferred::prepare_for_layout
+        procedure(new_page), deferred::new_page
         
         procedure(calculate_width), deferred::text_width
         procedure(calculate_height), deferred::text_height
@@ -34,6 +40,8 @@ implicit none
         
         procedure(draw_text), deferred::report_status
 
+        procedure(request_action), deferred::request_action
+
     end type renderer
 
     abstract interface
@@ -42,6 +50,13 @@ implicit none
         class(renderer)::self
         end subroutine initialize
     end interface
+    
+    abstract interface
+        subroutine new_page(self)
+        import::renderer
+        class(renderer)::self
+        end subroutine new_page
+    end interface
 
     abstract interface
         subroutine prepare_for_layout(self)
@@ -102,7 +117,16 @@ implicit none
         logical::request_input
         end function request_input
     end interface
-
+    
+    abstract interface
+        function request_action(self, text)
+        import::renderer
+        class(renderer)::self
+        character(*), intent(out)::text
+        integer::request_action
+        end function request_action
+    end interface
+    
 contains
  
     function width_of_line(r, text, startpos, endpos)
@@ -238,6 +262,7 @@ contains
             d_length = len_trim(url) - i_whitespace + 1
             allocate(character(len=d_length) :: display)
             display = adjustl(url(i_whitespace:len_trim(url)))
+            url = url(1:(i_whitespace-1))
         end if
         
         if(r%is_link_visible(display)) then
-- 
cgit v1.2.3