From e302c5cfcc30aa1b2e49ad5aa1fb524871618e43 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Fri, 25 Sep 2020 10:58:13 -0400 Subject: Added a homepage on Windows that showcases AppGraphics. --- ag_render.f90 | 586 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 312 insertions(+), 274 deletions(-) (limited to 'ag_render.f90') 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 -- cgit v1.2.3