From d53076ec22c34822c314264f664532883c87083b Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 14 May 2020 09:55:47 -0400 Subject: Initial commit of an AppGraphics renderer that actually works, though it doesn't scroll or allow url entry. --- ag_render.f90 | 514 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 514 insertions(+) create mode 100644 ag_render.f90 (limited to 'ag_render.f90') diff --git a/ag_render.f90 b/ag_render.f90 new file mode 100644 index 0000000..4d9be55 --- /dev/null +++ b/ag_render.f90 @@ -0,0 +1,514 @@ +! 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 -- cgit v1.2.3