aboutsummaryrefslogtreecommitdiff
path: root/dumb_render.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-05-05 11:04:22 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-05-05 11:04:22 -0400
commit0ade9914918238b8da35e995fe9782a517988ae2 (patch)
treeff9871528998544479a1a15144354d8b873ddc20 /dumb_render.f90
parent723324ae71f8209e4b1757a3f84bd0e66b6c6319 (diff)
downloadLR-87-0ade9914918238b8da35e995fe9782a517988ae2.tar.gz
LR-87-0ade9914918238b8da35e995fe9782a517988ae2.zip
Fixed link handling. Can now navigate links and page up/down.
Diffstat (limited to 'dumb_render.f90')
-rw-r--r--dumb_render.f9082
1 files changed, 78 insertions, 4 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