aboutsummaryrefslogtreecommitdiff
path: root/ag_render.f90
diff options
context:
space:
mode:
Diffstat (limited to 'ag_render.f90')
-rw-r--r--ag_render.f90514
1 files changed, 514 insertions, 0 deletions
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 <jeff@rainbow-100.com>
+!
+! 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