! Copyright (c) 2020 Jeffrey Armstrong ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! The Software shall be used for Good, not Evil. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. module ag_render use render use appgraphics implicit none integer, parameter::default_width = 600 integer, parameter::default_height = 700 integer, parameter::default_font_size = 18 integer, parameter::max_links_displayed = 64 logical, volatile::closed_browser logical, volatile::mouse_clicked type :: link integer, dimension(4)::location character(1024)::url end type type, extends(renderer) :: appgraphics_renderer integer::window_id integer::font_size integer::default_font integer::line_spacing integer::left_border, right_border integer::bullet_margin integer::text_color integer::link_color integer::background_color integer::link_count type(link), dimension(max_links_displayed)::links 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_porportional => 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 end type appgraphics_renderer contains subroutine window_closing_callback() implicit none closed_browser = .true. call stopidle() end subroutine window_closing_callback subroutine ag_initialize(self) use appgraphics implicit none class(appgraphics_renderer)::self closed_browser = .false. mouse_clicked = .false. 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_clicked) self%background_color = WHITE self%text_color = BLACK self%link_color = BLUE self%max_width = getmaxx() self%font_size = default_font_size self%default_font = SERIF_FONT self%line_spacing = 2 self%left_border = 5 self%right_border = 5 self%bullet_margin = 5 end subroutine ag_initialize function get_clicked_link(self) use appgraphics implicit none class(appgraphics_renderer)::self integer::get_clicked_link integer::i, mx, my get_clicked_link = -1 mx = mousex() my = mousey() 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_clicked_link = i exit end if end do end function get_clicked_link subroutine mouse_button_clicked(x, y) use appgraphics, only: stopidle implicit none integer::x, y mouse_clicked = .true. call stopidle() end subroutine mouse_button_clicked subroutine ag_prepare_for_layout(self) use appgraphics implicit none class(appgraphics_renderer)::self call setbkcolor(self%background_color) call resetviewport() call clearviewport() self%link_count = 0 end subroutine ag_prepare_for_layout subroutine ag_new_page(self) implicit none class(appgraphics_renderer)::self self%y = 0 end subroutine ag_new_page pure function get_font_size(self, heading) implicit none class(appgraphics_renderer), intent(in)::self integer, intent(in)::heading integer::get_font_size get_font_size = self%font_size if(heading == 1) then get_font_size = 2*get_font_size else if(heading > 1) then get_font_size = (3*get_font_size)/2 end if end function get_font_size function ag_text_width(self, text, heading, list_item) use appgraphics implicit none class(appgraphics_renderer)::self character(*), intent(in)::text integer, intent(in), optional::heading logical, intent(in), optional::list_item integer::ag_text_width integer::font_size font_size = self%font_size if(present(heading)) then font_size = get_font_size(self, heading) 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(list_item)) then if(list_item) then ag_text_width = ag_text_width + self%font_size/2 + 2*self%bullet_margin end if end if end function ag_text_width function ag_text_height(self, text, heading, list_item) use appgraphics implicit none class(appgraphics_renderer)::self character(*), intent(in)::text integer, intent(in), optional::heading logical, intent(in), optional::list_item integer::ag_text_height integer::font_size font_size = self%font_size if(present(heading)) then font_size = get_font_size(self, heading) 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, heading, list_item) use appgraphics implicit none class(appgraphics_renderer)::self character(*), intent(in)::text integer, intent(in), optional::heading logical, intent(in), optional::list_item integer::font_size integer::x, bx, by font_size = self%font_size if(present(heading)) then font_size = get_font_size(self, heading) end if x = self%left_border if(present(list_item)) then if(list_item) then 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 = bx + self%bullet_margin + self%font_size/2 end if end if call settextstyle(self%default_font, HORIZ_DIR, font_size) call setcolor(self%text_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)) 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 call settextstyle(MONOSPACE_FONT, HORIZ_DIR, self%font_size) if(len_trim(text) > 0) then ag_preformatted_width = textwidth(trim(text)) 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 class(appgraphics_renderer)::self 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 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 ! Pass for now... 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 implicit none class(appgraphics_renderer)::self character(*), intent(out)::text integer::ag_action integer::link_clicked ! Pass for now... call startidle(10000) ag_action = render_action_none if(closed_browser) then ag_action = render_action_quit else if(mouse_clicked) then link_clicked = get_clicked_link(self) if(link_clicked > 0) then text = self%links(link_clicked)%url ag_action = render_action_goto end if call clearmouseclick(MOUSE_LB_UP) end if 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 implicit none class(appgraphics_renderer)::self character(*), intent(in)::text call setwindowtitle("LR-87 :: "//trim(text)) end subroutine ag_report_page end module ag_render