aboutsummaryrefslogtreecommitdiff
path: root/dumb_render.f90
diff options
context:
space:
mode:
Diffstat (limited to 'dumb_render.f90')
-rw-r--r--dumb_render.f90101
1 files changed, 89 insertions, 12 deletions
diff --git a/dumb_render.f90 b/dumb_render.f90
index 64a3c40..31e7b9c 100644
--- a/dumb_render.f90
+++ b/dumb_render.f90
@@ -37,6 +37,8 @@ implicit none
character(len=1024), dimension(height)::link_urls
integer::first_line
+
+ logical::is_utf8
contains
@@ -76,14 +78,41 @@ implicit none
procedure :: report_displayed_page => dumb_displayed_page
+ procedure :: prompt_user
+ procedure :: prompt_user_more
+
end type dumb_renderer
contains
+ function len_trim_utf8(s) result(r)
+ use iso_c_binding
+ implicit none
+
+ character(*), intent(in)::s
+ integer::r
+
+ integer::cs
+ type(c_ptr)::cstr
+
+ integer::i
+
+ r = 0
+ do i = 1,len_trim(s)
+ cs = ichar(s(i:i))
+ if(iand(cs, 192) /= 128) then
+ r = r + 1
+ end if
+ end do
+
+ end function len_trim_utf8
+
subroutine dumb_initialize(self)
implicit none
class(dumb_renderer)::self
+ character(len=32)::lang
+ integer::iostatus
self%max_width = width
self%y = 0
@@ -92,6 +121,15 @@ contains
self%link_index = 0
self%link_urls = " "
+ self%is_utf8 = .FALSE.
+ call get_environment_variable("LANG", lang, status=iostatus)
+ if(iostatus == 0) then
+ self%is_utf8 = (index(lang, "utf-8") > 0 .or. &
+ index(lang, "UTF-8") > 0 .or. &
+ index(lang, "utf8") > 0 .or. &
+ index(lang, "UTF8") > 0)
+ end if
+
end subroutine dumb_initialize
subroutine dumb_new_page(self)
@@ -145,7 +183,11 @@ contains
integer, intent(in), optional::text_type
integer::dumb_text_width
- dumb_text_width = len_trim(text)
+ if(self%is_utf8) then
+ dumb_text_width = len_trim_utf8(text)
+ else
+ dumb_text_width = len_trim(text)
+ end if
if(present(text_type)) then
if(text_type == proportional_type_list_item) then
@@ -182,7 +224,11 @@ contains
character(*), intent(in)::text
integer::dumb_simple_width
- dumb_simple_width = len_trim(text)
+ if(self%is_utf8) then
+ dumb_simple_width = len_trim_utf8(text)
+ else
+ dumb_simple_width = len_trim(text)
+ end if
end function dumb_simple_width
@@ -215,17 +261,34 @@ contains
class(dumb_renderer)::self
character(*), intent(in)::text
- integer::limit_x
- character(5)::formatting
+ integer::limit_x, w
+ character(6)::formatting
+
+ if(self%is_utf8) then
+ w = len_trim_utf8(text)
+ else
+ w = len_trim(text)
+ end if
+ limit_x = len_trim(text)
+
+ do while(w > self%max_width)
+ limit_x = limit_x - 1
+ if(self%is_utf8) then
+ w = len_trim_utf8(text(1:limit_x))
+ else
+ w = limit_x
+ end if
+ end do
- limit_x = min(len_trim(text), self%max_width)
if(limit_x == 0) then
write(*,*) " "
else
if(limit_x < 10) then
write(formatting, '(A2, I1, A1)') '(A', limit_x, ')'
- else
+ else if(limit_x < 100) then
write(formatting, '(A2, I2, A1)') '(A', limit_x, ')'
+ else
+ write(formatting, '(A2, I3, A1)') '(A', limit_x, ')'
end if
write(*, formatting) text(1:limit_x)
@@ -389,22 +452,36 @@ contains
end subroutine dumb_ready_status
- subroutine prompt_user(input)
+ subroutine prompt_user(self, input)
implicit none
+ class(dumb_renderer)::self
character(*), intent(out)::input
+
+ if(len_trim(self%favicon) > 0 .and. self%is_utf8) then
+ write(*, '(A4)', advance='no') self%favicon
+ else
+ write(*, '(A3)', advance='no') "***"
+ end if
- write(*, '(A67)', advance='no') "*** [A]/[Z] PgUp/Dn | [#] Link | [B] Back | [M] More | [Q] Quit => "
+ write(*, '(1X, A63)', advance='no') "[A]/[Z] PgUp/Dn | [#] Link | [B] Back | [M] More | [Q] Quit => "
read(*, *) input
end subroutine prompt_user
- subroutine prompt_user_more(input)
+ subroutine prompt_user_more(self, input)
implicit none
+ class(dumb_renderer)::self
character(*), intent(out)::input
- write(*, '(A60)', advance='no') "*** [U] URL | [!] Save/Remove Fave | [L] Menu | [Q] Quit => "
+ if(len_trim(self%favicon) > 0 .and. self%is_utf8) then
+ write(*, '(A4)', advance='no') self%favicon
+ else
+ write(*, '(A3)', advance='no') "***"
+ end if
+
+ write(*, '(1X, A56)', advance='no') "[U] URL | [!] Save/Remove Fave | [L] Menu | [Q] Quit => "
read(*, *) input
end subroutine prompt_user_more
@@ -421,9 +498,9 @@ contains
character(256)::input
integer::link_id, iostatus
- call prompt_user(input)
+ call prompt_user(self, input)
if(trim(input) == 'M' .or. trim(input) == 'm') then
- call prompt_user_more(input)
+ call prompt_user_more(self, input)
end if
if(len_trim(input) == 0) then