diff options
| -rw-r--r-- | ag_render.f90 | 514 | ||||
| -rw-r--r-- | dumb_render.f90 | 23 | ||||
| -rw-r--r-- | gemini-windows.prj | 4 | ||||
| -rw-r--r-- | main.F90 | 22 | ||||
| -rw-r--r-- | render.f90 | 14 |
5 files changed, 560 insertions, 17 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 diff --git a/dumb_render.f90 b/dumb_render.f90 index 3834e5c..9142159 100644 --- a/dumb_render.f90 +++ b/dumb_render.f90 @@ -70,6 +70,8 @@ implicit none procedure :: request_save_filename => dumb_request_save_filename + procedure :: report_displayed_page => dumb_displayed_page + end type dumb_renderer contains @@ -129,8 +131,8 @@ contains class(dumb_renderer)::self character(*), intent(in)::text - integer, optional::heading - logical, optional::list_item + integer, intent(in), optional::heading + logical, intent(in), optional::list_item integer::dumb_text_width dumb_text_width = len_trim(text) @@ -148,8 +150,8 @@ contains class(dumb_renderer)::self character(*), intent(in)::text - integer, optional::heading - logical, optional::list_item + integer, intent(in), optional::heading + logical, intent(in), optional::list_item integer::dumb_text_height dumb_text_height = 1 @@ -224,8 +226,8 @@ contains class(dumb_renderer)::self character(*), intent(in)::text - integer, optional::heading - logical, optional::list_item + integer, intent(in), optional::heading + logical, intent(in), optional::list_item integer::limit_x character(5)::formatting character(self%max_width)::heading_line @@ -441,5 +443,14 @@ contains end function dumb_request_save_filename + subroutine dumb_displayed_page(self, text) + implicit none + + class(dumb_renderer)::self + character(*), intent(in)::text + + ! Nothing to do in this renderer + + end subroutine dumb_displayed_page end module dumb_render
\ No newline at end of file diff --git a/gemini-windows.prj b/gemini-windows.prj index 05c7a2e..c53c8ea 100644 --- a/gemini-windows.prj +++ b/gemini-windows.prj @@ -30,7 +30,7 @@ "Name":"+gemini-windows (lr87.exe)", "Files":[{ "filename":".\\ag_render.f90", - "enabled":"0" + "enabled":"1" },{ "filename":".\\dumb_render.f90", "enabled":"1" @@ -69,7 +69,7 @@ "Name":"gemini-windows (lr87.exe)", "Options":{ "Compiler Options":{ - "Fortran Flags":"-DWINDOWS", + "Fortran Flags":"-DWINDOWS -DWINDOWS_GUI", "Link Flags":"-lssl -lcrypto -lws2_32 -lcrypt32", "C Flags":"" }, @@ -23,8 +23,12 @@ program gemini use request +#ifdef WINDOWS_GUI +use ag_render, only: appgraphics_renderer +#else use dumb_render -!use ag_render, only: appgraphics_renderer +#endif + use render use gemini_protocol @@ -41,9 +45,13 @@ implicit none character(256)::initial_site character(1024)::current_url, input type(connection)::conn - type(dumb_renderer)::r - !type(appgraphics_renderer)::r +#ifdef WINDOWS_GUI + type(appgraphics_renderer)::r +#else + type(dumb_renderer)::r +#endif + logical::running logical::loaded logical::populated @@ -201,27 +209,35 @@ contains 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) 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("...") 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 @@ -69,6 +69,8 @@ implicit none procedure(draw_simple_text), deferred::report_status procedure(request_action), deferred::request_action + + procedure(draw_simple_text), deferred::report_displayed_page end type renderer @@ -98,8 +100,8 @@ implicit none import::renderer class(renderer)::self character(*), intent(in)::text - integer, optional::heading - logical, optional::list_item + integer, intent(in), optional::heading + logical, intent(in), optional::list_item integer::calculate_width end function calculate_width end interface @@ -109,8 +111,8 @@ implicit none import::renderer class(renderer)::self character(*), intent(in)::text - integer, optional::heading - logical, optional::list_item + integer, intent(in), optional::heading + logical, intent(in), optional::list_item integer::calculate_height end function calculate_height end interface @@ -120,8 +122,8 @@ implicit none import::renderer class(renderer)::self character(*), intent(in)::text - integer, optional::heading - logical, optional::list_item + integer, intent(in), optional::heading + logical, intent(in), optional::list_item end subroutine draw_text end interface |