aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ag_render.f90586
-rw-r--r--gemini-windows.prj6
-rw-r--r--internal.F90 (renamed from internal.f90)158
-rw-r--r--layout.f9045
-rw-r--r--main.F90169
-rw-r--r--render.f90159
6 files changed, 615 insertions, 508 deletions
diff --git a/ag_render.f90 b/ag_render.f90
index 3d08f35..235f3b4 100644
--- a/ag_render.f90
+++ b/ag_render.f90
@@ -25,16 +25,16 @@ use render
use appgraphics
implicit none
- integer, parameter::default_width = 600
+ integer, parameter::default_width = 640
integer, parameter::default_height = 700
-
+
integer, parameter::default_font_size = 18
-
+
integer, parameter::max_links_displayed = 64
integer, volatile::ag_render_event
integer, volatile::scroll_position
-
+
integer, parameter::ag_render_event_none = 0
integer, parameter::ag_render_event_closed = 1
integer, parameter::ag_render_event_mouseclick = 2
@@ -53,7 +53,7 @@ implicit none
end type
type, extends(renderer) :: appgraphics_renderer
-
+
integer::window_id
integer::address_id
integer::go_button_id
@@ -61,205 +61,210 @@ implicit none
integer::fave_button_id
integer::internal_button_id
integer::scroll_id
-
+
integer::font_size
integer::default_font
integer::line_spacing
-
+
+ ! Current window width
+ integer::width
+
integer::left_border, right_border
integer::bullet_margin
-
+
integer::text_color
integer::link_color
integer::background_color
-
+
integer::address_bar_height
integer::scroll_bar_width
integer::status_bar_height
-
+
integer::link_count
type(link), dimension(max_links_displayed)::links
-
+
! Needed to compute document height
integer::initial_y
-
+
! An error has occurred, so render blank
logical::render_blank
-
+
! A title was guessed and set
logical::title_guessed
-
+
contains
-
+
procedure :: initialize => ag_initialize
procedure :: new_page => ag_new_page
procedure :: prepare_for_layout => ag_prepare_for_layout
-
+
procedure :: text_width => ag_text_width
procedure :: text_height => ag_text_height
procedure :: is_text_visible => ag_text_visible
-
+
procedure :: draw_proportional => ag_text_draw
procedure :: preformatted_width => ag_preformatted_width
procedure :: preformatted_height => ag_preformatted_height
procedure :: is_preformatted_visible => ag_text_visible
-
+
procedure :: draw_preformatted => ag_preformatted_draw
-
+
procedure :: link_width => ag_link_width
procedure :: link_height => ag_link_height
procedure :: is_link_visible => ag_text_visible
-
+
procedure :: draw_link => ag_link_draw
-
+
procedure :: request_input => ag_request_input
-
+
procedure :: draw_error => ag_draw_error
-
+
procedure :: report_status => ag_draw_status
-
+
procedure :: request_action => ag_action
-
+
procedure :: request_save_filename => ag_request_save_filename
-
+
procedure :: report_displayed_page => ag_report_page
-
+
procedure :: report_unsupported_protocol => ag_report_unsupported_protocol
-
+
end type appgraphics_renderer
-
+
contains
-
+
subroutine window_closing_callback()
use appgraphics, only: stopidle
implicit none
-
+
ag_render_event = ag_render_event_closed
call stopidle()
-
+
end subroutine window_closing_callback
-
+
subroutine back_button_callback()
use appgraphics, only: stopidle
implicit none
-
+
ag_render_event = ag_render_event_back
call stopidle()
-
+
end subroutine back_button_callback
-
+
subroutine go_button_callback()
use appgraphics, only: stopidle
implicit none
-
+
ag_render_event = ag_render_event_go
call stopidle()
-
+
end subroutine go_button_callback
-
+
subroutine fave_button_callback()
use appgraphics, only: stopidle
implicit none
-
+
ag_render_event = ag_render_event_favorite
call stopidle()
-
+
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
-
+
integer::x, y
-
+
ag_render_event = ag_render_event_mouseclick
call stopidle()
-
+
end subroutine mouse_button_callback
-
+
subroutine mouse_move_callback(x, y)
use appgraphics, only: stopidle
implicit none
-
+
integer::x, y
-
+
ag_render_event = ag_render_event_mousemove
call stopidle()
-
+
end subroutine mouse_move_callback
-
+
subroutine mouse_wheel_callback(x, y)
use appgraphics, only: stopidle
implicit none
-
+
integer::x, y
-
+
scroll_position = scroll_position - (x/100)
if(scroll_position < 0) then
scroll_position = 0
else if(scroll_position > 100) then
scroll_position = 100
end if
-
+
ag_render_event = ag_render_event_wheel
call stopidle()
-
+
end subroutine mouse_wheel_callback
-
+
subroutine scrolled_callback(x)
use appgraphics, only: stopidle
implicit none
-
+
integer::x
scroll_position = x
ag_render_event = ag_render_event_scroll
call stopidle()
-
+
end subroutine scrolled_callback
-
+
subroutine resize_callback()
use appgraphics, only: stopidle
implicit none
-
+
ag_render_event = ag_render_event_resize
call stopidle()
-
+
end subroutine resize_callback
-
+
subroutine set_window_title(self, text)
use appgraphics, only: setwindowtitle
implicit none
-
+
type(appgraphics_renderer)::self
character(*), intent(in)::text
-
+
if(len_trim(text) > 0) then
call setwindowtitle("LR-87 :: "//trim(text))
else
call setwindowtitle("LR-87")
end if
-
+
end subroutine set_window_title
-
- subroutine draw_address_bar(self)
+
+ subroutine draw_address_bar(self, expanding)
use appgraphics
implicit none
-
+
type(appgraphics_renderer)::self
-
+ logical, optional::expanding
+
+ logical::myexpand
integer::x, address_width, label_x, ignored
-
+
! See below where this is used...
interface
function switch_to_thread() bind(c, name="SwitchToThread")
@@ -267,15 +272,21 @@ contains
integer(kind=c_int)::switch_to_thread
end function switch_to_thread
end interface
-
+
+ if(present(expanding)) then
+ myexpand = expanding
+ else
+ myexpand = .false.
+ endif
+
self%address_bar_height = 24
-
+
! Set up some address bar colors
call setfillstyle(SOLID_FILL, LIGHTGRAY)
call setbkcolor(LIGHTGRAY)
call setcolor(BLACK)
call settextstyle(SYMBOLS_FONT, HORIZ_DIR, 14)
-
+
! Draw the buttons first
x = 5
if(self%back_button_id < 0) then
@@ -283,89 +294,106 @@ contains
else
call setbuttonposition(self%back_button_id, x, 2, 40, 20)
end if
-
+
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
self%address_id = createtextbox(x, 2, address_width, 20)
call settextboxentercallback(self%address_id, go_button_callback)
- else
+ else
call settextboxposition(self%address_id, x, 2, address_width, 20)
end if
-
+
! 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, CHAR(232), go_button_callback)
else
call setbuttonposition(self%go_button_id, x, 2, 40, 20)
end if
-
+
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, 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)
+
+ ! If we're not expanding, just draw these buttons in order
+ if(.not. myexpand) then
+
+ x = getmaxx() - 95
+ if(self%fave_button_id < 0) then
+ 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
+
+ ! If expanding due to resize, we need to draw the rightmost first.
+ ! Also, the buttons would exist at this point for sure, so no need to
+ ! check for that anymore
else
+
+ x = getmaxx() - 45
call setbuttonposition(self%internal_button_id, x, 2, 40, 20)
+
+ x = x - 50
+ call setbuttonposition(self%fave_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
-
+
subroutine draw_status_bar(self, text)
use appgraphics
implicit none
-
+
type(appgraphics_renderer)::self
character(*), intent(in)::text
-
+
self%status_bar_height = 16
-
+
call resetviewport()
-
+
call setfillstyle(SOLID_FILL, LIGHTGRAY)
call setbkcolor(LIGHTGRAY)
call setcolor(BLACK)
call settextstyle(WINDOWS_FONT, HORIZ_DIR, 12)
-
+
call bar(0, getmaxy()-self%status_bar_height, getmaxx()+1, getmaxy()+1)
- call outtextxy(self%left_border+2, getmaxy()-self%status_bar_height+2, trim(text))
-
+ call outtextxy(5, getmaxy()-self%status_bar_height+2, trim(text))
+
end subroutine draw_status_bar
-
+
subroutine draw_scroll_bar(self)
use appgraphics
implicit none
-
+
type(appgraphics_renderer)::self
-
+
integer::h
-
+
self%scroll_bar_width = 15
h = getmaxy()-self%address_bar_height-self%status_bar_height - 1
if(self%scroll_id < 0) then
@@ -375,7 +403,7 @@ contains
h, &
SCROLL_VERTICAL, &
scrolled_callback)
-
+
call setscrollrange(self%scroll_id, 0, 100)
else
call setscrollbarposition(self%scroll_id, &
@@ -384,80 +412,81 @@ contains
self%scroll_bar_width, &
h)
end if
-
+
end subroutine draw_scroll_bar
-
+
function compute_max_width(self)
- use appgraphics, only: getmaxx
implicit none
-
+
type(appgraphics_renderer)::self
integer::compute_max_width
-
+
compute_max_width = getmaxx() - self%left_border - &
self%right_border - self%scroll_bar_width
-
+
end function compute_max_width
-
+
subroutine ag_initialize(self)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
self%window_id = initwindow(default_width, default_height, "LR-87", &
DEFAULT_POSITION, DEFAULT_POSITION, &
.FALSE., .FALSE.)
-
+
call setwindowclosecallback(window_closing_callback)
call registermousehandler(MOUSE_LB_UP, mouse_button_callback)
call registermousehandler(MOUSE_MOVE, mouse_move_callback)
call registermousehandler(MOUSE_WHEEL, mouse_wheel_callback)
call enableresize(resize_callback)
-
+
call setbkcolor(LIGHTGRAY)
call clearviewport()
-
+
self%address_id = -1
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)
call draw_status_bar(self, "Welcome to the LR-87 Gemini Client")
call draw_scroll_bar(self)
-
+
self%background_color = WHITE
self%text_color = BLACK
self%link_color = BLUE
-
+
self%max_width = compute_max_width(self)
self%font_size = default_font_size
self%default_font = SERIF_FONT
self%line_spacing = 2
- self%left_border = 5
- self%right_border = 5
+ self%left_border = 15
+ self%right_border = 15
self%bullet_margin = 5
-
+
self%render_blank = .false.
-
+
self%title_guessed = .false.
-
+
+ self%width = default_width
+
call setdialoghotkeys(.true.)
-
+
end subroutine ag_initialize
-
+
function get_link_at_mouse(self)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
integer::get_link_at_mouse
-
+
integer::i, mx, my
-
+
get_link_at_mouse = -1
mx = mousex()
my = mousey()
@@ -465,102 +494,102 @@ contains
do i = 1, self%link_count
if(my >= self%links(i)%location(2) .and. my <= self%links(i)%location(4) .and. &
mx >= self%links(i)%location(1) .and. mx <= self%links(i)%location(3)) then
-
+
get_link_at_mouse = i
exit
end if
end do
-
+
end function get_link_at_mouse
-
+
subroutine ag_prepare_for_layout(self)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
-
+
call setbkcolor(self%background_color)
call resetviewport()
-
+
call setviewport(0, &
self%address_bar_height+1, &
getmaxx() - self%scroll_bar_width + 1, &
getmaxy() - self%status_bar_height, &
- .true.)
-
+ .true.)
+
call clearviewport()
-
+
self%link_count = 0
self%initial_y = self%y
-
+
end subroutine ag_prepare_for_layout
-
+
subroutine ag_new_page(self)
implicit none
-
+
class(appgraphics_renderer)::self
-
+
self%y = 0
scroll_position = 0
-
+
call setscrollposition(self%scroll_id, 0)
ag_render_event = ag_render_event_none
-
+
self%title_guessed = .false.
-
+
end subroutine ag_new_page
-
+
pure function get_font_size(self, text_type)
implicit none
-
+
class(appgraphics_renderer), intent(in)::self
integer, intent(in)::text_type
integer::get_font_size
-
+
get_font_size = self%font_size
if(text_type == proportional_type_heading_1) then
get_font_size = 2*get_font_size
else if(text_type > proportional_type_heading_1) then
get_font_size = (3*get_font_size)/2
end if
-
+
end function get_font_size
-
+
pure function get_indent_margin(self)
implicit none
-
+
type(appgraphics_renderer), intent(in)::self
integer::get_indent_margin
-
- get_indent_margin = self%font_size + 2*self%bullet_margin
-
+
+ get_indent_margin = self%left_border + self%font_size + 2*self%bullet_margin
+
end function get_indent_margin
-
+
function ag_text_width(self, text, text_type)
use appgraphics
use render
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer, intent(in), optional::text_type
integer::ag_text_width
integer::font_size
-
+
font_size = self%font_size
if(present(text_type)) then
font_size = get_font_size(self, text_type)
end if
-
+
call settextstyle(self%default_font, HORIZ_DIR, font_size)
if(len_trim(text) > 0) then
ag_text_width = textwidth(trim(text))
else
ag_text_width = 0
end if
-
+
ag_text_width = ag_text_width + self%left_border + self%right_border
-
+
if(present(text_type)) then
if(text_type == proportional_type_list_item) then
ag_text_width = ag_text_width + get_indent_margin(self)
@@ -568,155 +597,159 @@ contains
ag_text_width = ag_text_width + 2 * get_indent_margin(self)
end if
end if
-
+
end function ag_text_width
-
+
function ag_text_height(self, text, text_type)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer, intent(in), optional::text_type
integer::ag_text_height
integer::font_size
-
+
font_size = self%font_size
if(present(text_type)) then
font_size = get_font_size(self, text_type)
end if
-
+
call settextstyle(self%default_font, HORIZ_DIR, font_size)
if(len_trim(text) > 0) then
ag_text_height = textheight(trim(text)) + self%line_spacing
else
ag_text_height = self%line_spacing + self%font_size
end if
-
+
end function ag_text_height
-
+
function ag_text_visible(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
logical::ag_text_visible
-
+
ag_text_visible = (self%y > 0 .and. self%y < getmaxy())
-
+
end function ag_text_visible
-
+
subroutine ag_text_draw(self, text, text_type)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer, intent(in), optional::text_type
integer::font_size
integer::x, bx, by
integer::font_color
-
+
font_size = self%font_size
font_color = self%text_color
x = self%left_border
-
+
if(present(text_type)) then
font_size = get_font_size(self, text_type)
-
+
select case(text_type)
-
+
case (proportional_type_heading_1)
! The first level 1 heading can be guessed as the page title
if(.not. self%title_guessed) then
-
+
call set_window_title(self, text)
self%title_guessed = .true.
-
+
end if
-
+
case (proportional_type_list_item)
! If a list item, need to draw a box
bx = x + self%bullet_margin
by = self%y + self%font_size/4
-
+
call setfillstyle(SOLID_FILL, self%text_color)
call bar(bx, by, bx+self%font_size/2, by+self%font_size/2)
-
+
x = get_indent_margin(self)
-
+
case (proportional_type_quotation)
! Scoot in and draw grey
x = x + get_indent_margin(self)
font_color = DARKGRAY
-
+
end select
end if
-
+
call settextstyle(self%default_font, HORIZ_DIR, font_size)
call setcolor(font_color)
call outtextxy(x, self%y, trim(text))
-
+
end subroutine ag_text_draw
-
+
function ag_link_width(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer::ag_link_width
ag_link_width = ag_text_width(self, text)
-
+
end function ag_link_width
-
+
function ag_link_height(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer::ag_link_height
-
+
ag_link_height = ag_text_height(self, text)
-
+
end function ag_link_height
subroutine ag_link_draw(self, text, url)
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text, url
integer::text_width
-
+
call settextstyle(self%default_font, HORIZ_DIR, self%font_size)
call setcolor(self%link_color)
call outtextxy(self%left_border, self%y, trim(text))
-
+
text_width = ag_link_width(self, trim(text))
+
+ ! Need to remove indents, borders, etc.
+ text_width = text_width - self%left_border - self%right_border
+
call line(self%left_border, self%y + 7*self%font_size/8, &
self%left_border + text_width, self%y + 7*self%font_size/8)
-
+
! Store this link
self%link_count = self%link_count + 1
if(self%link_count < max_links_displayed) then
self%links(self%link_count)%location(1) = self%left_border
self%links(self%link_count)%location(2) = self%y
-
+
self%links(self%link_count)%location(3) = self%left_border + text_width
self%links(self%link_count)%location(4) = self%y + self%font_size
-
+
self%links(self%link_count)%url = url
end if
-
+
end subroutine ag_link_draw
-
+
function ag_preformatted_width(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer::ag_preformatted_width
@@ -727,42 +760,42 @@ contains
else
ag_preformatted_width = 0
end if
-
+
ag_preformatted_width = ag_preformatted_width + self%left_border + self%right_border
-
+
end function ag_preformatted_width
-
+
function ag_preformatted_height(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
integer::ag_preformatted_height
-
+
call settextstyle(MONOSPACE_FONT, HORIZ_DIR, self%font_size)
if(len_trim(text) > 0) then
ag_preformatted_height = textheight(trim(text)) + self%line_spacing
else
ag_preformatted_height = self%font_size + self%line_spacing
end if
-
+
end function ag_preformatted_height
-
+
subroutine ag_preformatted_draw(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
-
+
call settextstyle(MONOSPACE_FONT, HORIZ_DIR, self%font_size)
call setcolor(BLACK)
call outtextxy(self%left_border, self%y, trim(text))
-
+
end subroutine ag_preformatted_draw
-
+
function ag_request_input(self, question, answer)
use appgraphics
implicit none
@@ -771,82 +804,84 @@ contains
character(*), intent(in)::question
character(*), intent(out)::answer
logical::ag_request_input
-
+
ag_request_input = dlgrequesttext(answer, "Input Requested", question)
-
+
end function ag_request_input
-
+
subroutine ag_draw_error(self, text)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
-
+
! Force blank draw
self%render_blank = .true.
ag_render_event = ag_render_event_resize
-
+
call dlgmessage(0, text)
-
+
end subroutine ag_draw_error
-
+
subroutine ag_draw_status(self, text)
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
-
+
call draw_status_bar(self, text)
-
+
end subroutine ag_draw_status
-
+
function ag_action(self, text)
use render, only: render_action_none, render_action_layout, &
render_action_goto, render_action_quit, &
idle_status
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(out)::text
integer::ag_action
integer::link_clicked, link_under
integer::ignored
-
+
+ logical::expanding_horizontally
+
! For scrolling
integer::doclength
-
+
! Resize can be laggy, so ensure it actually was finalized
if(self%max_width /= compute_max_width(self)) then
ag_render_event = ag_render_event_resize
end if
-
+
if(ag_render_event == ag_render_event_none) then
call startidle(10000)
end if
-
+
ag_action = render_action_none
select case (ag_render_event)
-
+
case(ag_render_event_closed)
ag_action = render_action_quit
-
+
case(ag_render_event_back)
ag_action = render_action_back
-
+
case(ag_render_event_go)
ignored = gettextboxcontents(self%address_id, text)
ag_action = render_action_goto
-
+
case(ag_render_event_mouseclick)
link_clicked = get_link_at_mouse(self)
if(link_clicked > 0) then
text = self%links(link_clicked)%url
ag_action = render_action_goto
end if
-
+
call clearmouseclick(MOUSE_LB_UP)
-
+
case(ag_render_event_mousemove)
link_under = get_link_at_mouse(self)
if(link_under > 0) then
@@ -854,95 +889,98 @@ contains
else
call self%status_ready()
end if
-
+
call clearmouseclick(MOUSE_MOVE)
-
+
case(ag_render_event_wheel)
call setscrollposition(self%scroll_id, scroll_position)
-
+
doclength = self%y - self%initial_y
self%y = (doclength * scroll_position) / (-100)
ag_action = render_action_layout
-
+
case(ag_render_event_scroll)
doclength = self%y - self%initial_y
self%y = (doclength * scroll_position) / (-100)
ag_action = render_action_layout
-
+
case(ag_render_event_resize)
-
+
+ expanding_horizontally = (getmaxx() > self%width)
+ self%width = getmaxx()
+
! Effectively have to redraw everything
- call draw_address_bar(self)
+ call draw_address_bar(self, expanding=expanding_horizontally)
call draw_status_bar(self, idle_status)
call draw_scroll_bar(self)
call setscrollposition(self%scroll_id, 0)
-
+
! Need to recompute the max width for the layout engine
self%max_width = compute_max_width(self)
self%y = 0
-
+
ag_action = render_action_rewrap
-
+
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
-
+
! if a layout was requested, but we're blank...
if(ag_action == render_action_layout .and. self%render_blank) then
call ag_prepare_for_layout(self) ! This clears the screen fine
end if
-
+
! We've handled the event here, reset to none
ag_render_event = ag_render_event_none
-
+
end function ag_action
-
+
function ag_request_save_filename(self, url, mimetype, filename)
use appgraphics
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::url
character(*), intent(in)::mimetype
character(*), intent(out)::filename
logical::ag_request_save_filename
-
+
ag_request_save_filename = dlgsavefile(filename)
-
+
end function ag_request_save_filename
-
+
subroutine ag_report_page(self, text)
use appgraphics
use internal_links, only: internal_url
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::text
-
+
call set_window_title(self, text)
-
+
if(index(text, "gemini://") > 0 .or. index(text, internal_url) > 0) then
call settextboxcontents(self%address_id, trim(text))
end if
-
+
end subroutine ag_report_page
-
+
function ag_report_unsupported_protocol(self, url)
use iso_c_binding, only: c_null_char, c_null_ptr
use appgraphics, only: dlgyesno
implicit none
-
+
class(appgraphics_renderer)::self
character(*), intent(in)::url
logical::ag_report_unsupported_protocol
type(c_ptr)::ret
-
+
interface
function ShellExecute(h, verb, filename, params, dir, showcmd) bind(c, name="ShellExecuteA")
use iso_c_binding
@@ -955,20 +993,20 @@ contains
type(c_ptr)::ShellExecute
end function ShellExecute
end interface
-
+
if(dlgyesno(DIALOG_WARN, "Ask Windows to open "//trim(url)//" in another program?")) then
-
+
ret = ShellExecute(c_null_ptr, &
"open"//c_null_char, &
trim(url)//c_null_char, &
c_null_ptr, &
c_null_ptr, &
5) ! 5 is SW_SHOW
-
+
end if
-
+
ag_report_unsupported_protocol = .false.
-
+
end function ag_report_unsupported_protocol
-
+
end module ag_render
diff --git a/gemini-windows.prj b/gemini-windows.prj
index 37bb035..02dff4f 100644
--- a/gemini-windows.prj
+++ b/gemini-windows.prj
@@ -2,14 +2,14 @@
"Root":{
"Folders":[{
"Folders":[],
- "Name":"+samples",
+ "Name":"-samples",
"Files":[{
"filename":".\\samples\\sample1.gmi",
"enabled":"1"
}]
},{
"Folders":[],
- "Name":"+ssl",
+ "Name":"-ssl",
"Files":[{
"filename":".\\jessl.f90",
"enabled":"1"
@@ -56,7 +56,7 @@
"filename":".\\history.f90",
"enabled":"1"
},{
- "filename":".\\internal.f90",
+ "filename":".\\internal.F90",
"enabled":"1"
},{
"filename":".\\layout.f90",
diff --git a/internal.f90 b/internal.F90
index 9e3aab9..5ef2c5d 100644
--- a/internal.f90
+++ b/internal.F90
@@ -28,24 +28,23 @@ implicit none
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.
@@ -55,18 +54,23 @@ contains
else if(index(requested_operation, "favorites") == 1) then
call handle_favorites(unit_number, trim(requested_operation), faves)
handle_internal_url = .true.
+#ifdef WINDOWS
+ else if(index(requested_operation, "home") == 1) then
+ call handle_home(unit_number)
+ handle_internal_url = .true.
+#endif
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,')'
@@ -75,79 +79,84 @@ contains
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))
-
+
+#ifdef WINDOWS
write(unit_number, *)
-
+ call write_no_space(unit_number, "=> lr87://home Start Page")
+#endif
+
+ 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 "//&
@@ -173,40 +182,91 @@ contains
"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
+ 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
-
+
+ subroutine handle_home(unit_number)
+ implicit none
+
+ integer, intent(in)::unit_number
+
+ call write_nonsense_status(unit_number)
+
+ call write_no_space(unit_number, "# A Gemini Browser Written in Simply Fortran")
+
+ write(unit_number, *)
+
+ call write_no_space(unit_number, "LR-87 is a browser for the Gemini protocol, which is similar to the World Wide "// &
+ "Web, only smaller and simpler. This browser implements the much of the Gemini "// &
+ "protocol, including browsing and user input. On Microsoft Windows, the LR-87 "// &
+ "browser uses Simply Fortran's AppGraphics package for all rendering.")
+
+ write(unit_number, *)
+
+ call write_no_space(unit_number, "Simply Fortran is a full-featured integrated development environment for the "// &
+ "Fortran programming language. It includes a complete, pre-configured Fortran " // &
+ "compiler and tool suite in addition to the development environment, meaning there "// &
+ "is nothing else for the user to configure and install. Included with the package "// &
+ "is the AppGraphics library, which enables the creation of full-featured graphical "// &
+ "user interfaces written entirely in Fortran. If you'd like to learn more about "// &
+ "Simply Fortran, click the link below (which will open a web browser):")
+
+ write(unit_number, *)
+
+ call write_no_space(unit_number, "=> https://simplyfortran.com/?platform=windows Simply Fortran Home Page")
+
+ write(unit_number, *)
+
+ call write_no_space(unit_number, "## Sites to See in Gemini Space")
+
+ write(unit_number, *)
+
+ call write_no_space(unit_number, "=> gemini://gus.guru/ Gemini Universal Search - search all sites in Gemini")
+
+ call write_no_space(unit_number, "=> gemini://rawtext.club:1965/~sloum/spacewalk.gmi Spacewalk - "// &
+ "a list of recently updated Gemini sites")
+
+ call write_no_space(unit_number, "=> gemini://rainbow-100.com/software/lr87.gmi LR-87 Site - "// &
+ "the primary home of the LR-87 browser")
+
+ call write_no_space(unit_number, "=> gemini://gemini.circumlunar.space/ More About the Gemini Protocol")
+
+ call write_no_space(unit_number, "=> lr87://about More About the LR-87 Gemini browser")
+
+
+ end subroutine handle_home
+
end module internal_links \ No newline at end of file
diff --git a/layout.f90 b/layout.f90
index 73c085c..9946fd9 100644
--- a/layout.f90
+++ b/layout.f90
@@ -55,31 +55,30 @@ contains
call rendering_engine%prepare_for_layout()
do while(laying_out)
-
if(walker%line_type == line_type_text .and. .not. associated(walker%breaks)) then
walker%breaks => calculate_wrapping(rendering_engine, walker%text)
end if
-
+
select case (walker%line_type)
-
+
case (line_type_text)
call render_proportional(rendering_engine, walker%text, walker%breaks)
-
+
case (line_type_preformatted)
call render_preformatted(rendering_engine, walker%text)
-
+
case (line_type_link)
call render_link(rendering_engine, walker%text)
-
+
end select
-
+
laying_out = associated(walker%next)
if(laying_out) then
walker => walker%next
end if
-
+
end do
-
+
end subroutine layout_lines
subroutine clear_line_breaks(first_line)
@@ -89,44 +88,44 @@ contains
type(line), pointer::walker
walker => first_line
-
+
do while(associated(walker))
if(associated(walker%breaks)) then
deallocate(walker%breaks)
walker%breaks => null()
end if
-
+
walker => walker%next
-
+
end do
-
+
end subroutine clear_line_breaks
subroutine free_lines(first_line)
implicit none
-
+
type(line), intent(inout), pointer::first_line
-
+
type(line), pointer::walker, past
-
+
call clear_line_breaks(first_line)
-
+
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 0926192..7d9206e 100644
--- a/main.F90
+++ b/main.F90
@@ -98,145 +98,148 @@ implicit none
end if
else
-
- initial_site = "gemini://gemini.circumlunar.space/"
-
+#ifdef WINDOWS
+ initial_site = "lr87://home"
+#else
+ initial_site = "gemini://gus.guru/"
+#endif
+
end if
-
+
running = .true.
loaded = .false.
redo_layout = .false.
call r%initialize()
-
+
! Load in any favorites
faves => load_favorites()
-
+
locations_visited => null()
desired_url = initial_site
current_url = " "
first_line => null()
-
+
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
-
+
redo_layout = r%report_unsupported_protocol(trim(desired_url))
- populated = .false.
+ populated = .false.
loaded = .true.
return_code = STATUS_PROTOCOLFAIL
-
+
end if
-
+
if(.not. loaded) then
-
+
call r%report_status("Requesting "//trim(desired_url))
-
+
return_code = request_url(desired_url, io, return_type, bh)
populated = .not. is_failure_code(return_code)
call update_status(r, desired_url, return_code)
-
+
end if
-
- if(return_code == STATUS_REDIRECT) then
-
+
+ if(return_code == STATUS_REDIRECT) then
+
call get_redirect_url(io, desired_url)
loaded = .false.
populated = .false.
-
+
else if(return_code == STATUS_INPUT) then
-
+
if(handle_input(r, desired_url, io)) then
! Should force a new load
loaded = .false.
else
loaded = .true.
end if
-
+
else if(populated) then
-
+
current_url = desired_url
desired_url = " "
-
+
locations_visited => add_location(locations_visited, current_url)
-
+
if(r%type_supported(return_type)) then
-
+
! Only erase if we're loading new lines!
if(associated(first_line)) then
call free_lines(first_line)
end if
-
+
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)
call r%status_ready()
-
+
else
-
+
call r%draw_error("Cannot display file of type "//return_type)
call back_location(locations_visited, desired_url)
-
+
end if
-
+
else if(redo_layout) then
-
+
if(associated(first_line)) then
call r%report_status("Performing Layout")
call layout_lines(first_line, r)
call r%status_ready()
end if
-
+
redo_layout = .false.
-
+
else if(.not. redo_layout .and. is_failure_code(return_code) .and. len_trim(current_url) == 0) then
-
+
call r%draw_error("Exiting without initial site")
running = .false.
-
+
else if(is_failure_code(return_code)) then
-
+
! Only explicitly show an error if it isn't a protocol failure
if(return_code /= STATUS_PROTOCOLFAIL) then
call r%draw_error("Could not connect to "//desired_url)
end if
-
+
loaded = .true.
-
+
end if
-
+
do while(loaded .and. running)
-
+
select case(r%request_action(input))
case (render_action_quit)
running = .false.
-
+
case (render_action_back)
call back_location(locations_visited, desired_url)
loaded = .false.
-
+
case (render_action_layout)
if(associated(first_line)) then
call r%report_status("Performing Layout")
call layout_lines(first_line, r)
call r%status_ready()
end if
-
+
case (render_action_rewrap)
if(associated(first_line)) then
call r%report_status("Performing Layout")
@@ -244,7 +247,7 @@ implicit none
call layout_lines(first_line, r)
call r%status_ready()
end if
-
+
case (render_action_goto)
if(index(input, "://") > 0) then
desired_url = input
@@ -252,9 +255,9 @@ implicit none
desired_url = current_url
call handle_relative_url(desired_url, input)
end if
-
+
loaded = .false.
-
+
case (render_action_favorite)
if(is_favorite(faves, current_url)) then
call remove_favorite(faves, current_url)
@@ -264,12 +267,12 @@ implicit none
call r%report_status("Added favorite: "//trim(current_url))
end if
call save_favorites(faves)
-
+
end select
-
- end do
+
+ end do
end do
-
+
close(io)
contains
@@ -277,25 +280,25 @@ contains
subroutine update_status(r, url, code)
use gemini_protocol
implicit none
-
+
class(renderer)::r
character(*), intent(in)::url
integer, intent(in)::code
-
+
select case (code)
-
+
case (STATUS_LOCALFAIL)
call r%report_status("Network failure loading "//trim(url))
call r%report_displayed_page("...")
-
+
case (STATUS_INPUT)
call r%report_status("Ok (input)")
call r%report_displayed_page(url)
-
+
case (STATUS_SUCCESS)
call r%report_status("Ok")
call r%report_displayed_page(url)
-
+
case (STATUS_REDIRECT)
call r%report_status("Ok (redirect)")
call r%report_displayed_page(url)
@@ -303,7 +306,7 @@ contains
case (STATUS_TEMPFAIL)
call r%report_status("Server reports temporary failure")
call r%report_displayed_page("...")
-
+
case (STATUS_PERMFAIL)
call r%report_status("Server reports permanent failure")
call r%report_displayed_page("...")
@@ -311,61 +314,61 @@ contains
case (STATUS_CERTREQ)
call r%report_status("Server requesting certificate (unsupported)")
call r%report_displayed_page("...")
-
+
case (STATUS_BADRESPONSE)
call r%report_status("Bad response code from server")
call r%report_displayed_page("...")
-
+
end select
-
+
end subroutine update_status
-
+
function load_favorites() result(faves)
use platform, only: get_favorites_file
use favorite_handling, only: read_favorites, favorite
implicit none
-
+
type(favorite), dimension(:), pointer::faves
-
+
character(260)::filename
integer::ios, loadunit
-
+
call get_favorites_file(filename)
-
+
open(newunit=loadunit, file=filename, status='old', action='read', iostat=ios)
if(ios == 0) then
-
+
faves => read_favorites(loadunit)
close(loadunit)
-
+
else
-
+
faves => null()
-
+
end if
-
+
end function load_favorites
-
+
subroutine save_favorites(faves)
use platform, only: get_favorites_file
use favorite_handling, only: write_favorites, favorite
implicit none
-
+
type(favorite), dimension(:), intent(in), pointer::faves
-
+
character(260)::filename
integer::ios, loadunit
-
+
call get_favorites_file(filename)
-
+
open(newunit=loadunit, file=filename, status='unknown', action='write', iostat=ios)
if(ios == 0) then
-
+
call write_favorites(loadunit, faves)
close(loadunit)
-
+
end if
-
+
end subroutine save_favorites
-
+
end program gemini
diff --git a/render.f90 b/render.f90
index 3cbb2bc..74b1406 100644
--- a/render.f90
+++ b/render.f90
@@ -306,45 +306,51 @@ contains
end if
endpos = len_trim(text)
+
w = width_of_line(r, text, my_start, endpos, proportional_type)
if(w > r%max_width) then
w = 0
endpos = startpos+1
- do while(w <= r%max_width)
+ do while(w <= r%max_width .and. endpos < len_trim(text))
last_end = endpos
endpos = endpos + 1
- do while(text(endpos:endpos) /= ' ' .and. text(endpos:endpos) /= '-')
+ do while(text(endpos:endpos) /= ' ' .and. text(endpos:endpos) /= '-' .and. endpos < len_trim(text))
endpos = endpos + 1
end do
- w = width_of_line(r, text, my_start, endpos, proportional_type)
+ if(my_start < endpos) then
+ w = width_of_line(r, text, my_start, endpos, proportional_type)
+ else
+ w = 0
+ exit
+ end if
end do
-
+
endpos = last_end
-
+
end if
-
+
end function wrap_line
-
+
function get_start_position_and_type(text, proportional_type) result(startpos)
implicit none
-
+
character(*), intent(in)::text
integer, intent(out)::proportional_type
integer::startpos
-
+
startpos = 1
proportional_type = proportional_type_normal
-
+
! Check for headings first
- do while(text(startpos:startpos) == '#')
+ do while(text(startpos:startpos) == '#')
proportional_type = proportional_type + 1
startpos = startpos + 1
end do
-
+
if(proportional_type == proportional_type_normal) then
if(text(1:1) == '*') then
proportional_type = proportional_type_list_item
@@ -361,113 +367,114 @@ contains
startpos = startpos + 1
end do
end if
-
+
end function get_start_position_and_type
-
+
function calculate_wrapping(r, text) result(breaks)
implicit none
-
+
class(renderer)::r
character(*), intent(in)::text
integer, dimension(:), pointer::breaks
-
+
integer::startpos, endpos
integer::proportional_type
logical::list_item, quotation
-
+
integer::current_allocation
integer::break_count
integer, dimension(:), pointer::realloc
-
+
current_allocation = 16
break_count = 0
allocate(breaks(current_allocation))
if(len_trim(text) > 0) then
-
+
startpos = get_start_position_and_type(text, proportional_type)
-
+
endpos = wrap_line(r, text, startpos, proportional_type)
do while(endpos > startpos)
-
+
! Save this break
break_count = break_count + 1
-
+
! Messy memory handling...
if(break_count > current_allocation) then
realloc => breaks
breaks => null()
-
+
allocate(breaks(current_allocation + 16))
breaks(1:current_allocation) = realloc
current_allocation = current_allocation + 16
deallocate(realloc)
end if
-
+
! Now actually save it
breaks(break_count) = endpos
-
+
! Advance string positions
startpos = endpos+1
do while(text(startpos:startpos) == ' ')
startpos = startpos + 1
end do
-
+
! Do not mark as a list item for subsequent lines
if(proportional_type == proportional_type_list_item) then
proportional_type = proportional_type_normal
end if
-
+
endpos = wrap_line(r, text, startpos, proportional_type)
+
end do
end if
-
+
break_count = break_count + 1
-
+
! Messy memory handling...
if(break_count > current_allocation) then
realloc => breaks
breaks => null()
-
+
allocate(breaks(current_allocation + 16))
breaks(1:current_allocation) = realloc
current_allocation = current_allocation + 16
deallocate(realloc)
end if
-
+
! Save an ending indicator
breaks(break_count) = last_break
-
+
end function calculate_wrapping
-
+
subroutine render_proportional(r, text, breaks)
implicit none
-
+
class(renderer)::r
character(*)::text
integer, dimension(:)::breaks
-
+
integer::startpos, endpos
integer::proportional_type
integer::break_index
-
- if(len_trim(text) == 0) then
-
+
+ if(len_trim(text) == 0) then
+
if(r%is_text_visible(" ")) then
call r%draw_proportional("")
end if
r%y = r%y + r%text_height(" ")
-
+
else
-
+
startpos = get_start_position_and_type(text, proportional_type)
-
+
break_index = 1
endpos = breaks(break_index)
if(endpos == last_break) then
endpos = len_trim(text)
end if
-
+
do while(endpos > startpos)
if(r%is_text_visible(text(startpos:endpos))) then
call r%draw_proportional(text(startpos:endpos), &
@@ -475,18 +482,18 @@ contains
end if
r%y = r%y + r%text_height(text(startpos:endpos), &
text_type=proportional_type)
-
+
! Advance string positions
startpos = endpos+1
do while(text(startpos:startpos) == ' ')
startpos = startpos + 1
end do
-
+
! Do not mark as a list item for subsequent lines
if(proportional_type == proportional_type_list_item) then
proportional_type = proportional_type_normal
end if
-
+
if(breaks(break_index) /= last_break) then
break_index = break_index + 1
endpos = breaks(break_index)
@@ -494,39 +501,39 @@ contains
endpos = len_trim(text)
end if
end if
-
+
end do
end if
-
+
end subroutine render_proportional
-
+
subroutine render_preformatted(r, text)
implicit none
-
+
class(renderer)::r
character(*)::text
-
+
if(r%is_preformatted_visible(text)) then
call r%draw_preformatted(text)
end if
r%y = r%y + r%preformatted_height(text)
-
+
end subroutine render_preformatted
-
+
subroutine render_link(r, text)
implicit none
-
+
class(renderer)::r
character(*)::text
integer::i_whitespace, d_length, i_start_display
-
+
character(len=:), allocatable::url, display
-
- ! Find the url first - just allocate the same
+
+ ! Find the url first - just allocate the same
! size as the text, good enough...
allocate(character(len=len_trim(text)) :: url)
url = adjustl(text)
-
+
! The display text occurs after the first whitespace
! in url now
i_whitespace = index(trim(url)," ")
@@ -535,14 +542,14 @@ contains
i_whitespace = index(trim(url), CHAR(9))
end if
end if
-
+
if(i_whitespace == 0) then
allocate(character(len=len_trim(url)) :: display)
display = url
else
d_length = len_trim(url) - i_whitespace + 1
allocate(character(len=d_length) :: display)
-
+
! Adjustl doesn't handle tabs, so we need to do this manually...
i_start_display = i_whitespace
do while(any([" ", char(9)] == url(i_start_display:i_start_display)))
@@ -551,57 +558,57 @@ contains
display = url(i_start_display:len_trim(url))
url = url(1:(i_whitespace-1))
end if
-
+
if(r%is_link_visible(display)) then
call r%draw_link(display, url)
end if
r%y = r%y + r%link_height(display)
-
+
deallocate(url)
deallocate(display)
-
+
end subroutine render_link
-
+
function handle_input(r, url, unit_number)
use escaper
implicit none
-
+
class(renderer)::r
character(*), intent(inout)::url
integer, intent(in)::unit_number
-
+
logical::handle_input
-
+
character(1024)::response_line
character(256)::answer
integer::question_index
-
+
rewind(unit_number)
-
+
read(unit_number, '(A1024)') response_line
question_index = 3
do while(response_line(question_index:question_index) == " " .or. &
response_line(question_index:question_index) == char(9))
-
+
question_index = question_index + 1
-
+
end do
-
+
handle_input = r%request_input(response_line(question_index:len_trim(response_line)), &
answer)
-
+
if(handle_input) then
question_index = index(url, "?")
if(question_index < 1) then
url = trim(url)//"?"
question_index = len_trim(url)
end if
-
+
call escape_string(answer)
-
+
url = url(1:question_index)//answer
end if
-
+
end function handle_input
-
+
end module render