diff options
| -rw-r--r-- | ag_render.f90 | 586 | ||||
| -rw-r--r-- | gemini-windows.prj | 6 | ||||
| -rw-r--r-- | internal.F90 (renamed from internal.f90) | 158 | ||||
| -rw-r--r-- | layout.f90 | 45 | ||||
| -rw-r--r-- | main.F90 | 169 | ||||
| -rw-r--r-- | render.f90 | 159 |
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 @@ -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 @@ -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 @@ -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 |