! 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 render implicit none integer, parameter::render_action_none = 1 integer, parameter::render_action_goto = 2 integer, parameter::render_action_layout = 3 integer, parameter::render_action_back = 4 integer, parameter::render_action_rewrap = 5 integer, parameter::render_action_quit = 6 integer, parameter::render_action_favorite = 7 integer, parameter::last_break = -1 integer, parameter::proportional_type_normal = 0 integer, parameter::proportional_type_list_item = -1 integer, parameter::proportional_type_quotation = -2 integer, parameter::proportional_type_heading_1 = 1 ! For heading level, it's just positive character(11), dimension(2)::base_supported_types = & ["text/plain ", & "text/gemini" ] character(*), parameter::idle_status = "LR-87 Ready" type, abstract :: renderer integer::y integer::max_width character(4)::favicon contains procedure::render_proportional procedure::type_supported procedure::status_ready procedure::report_unsupported_protocol procedure::set_favicon procedure::clear_favicon procedure(initialize), deferred::initialize procedure(prepare_for_layout), deferred::prepare_for_layout procedure(layout_complete), deferred::layout_complete procedure(new_page), deferred::new_page procedure(calculate_width), deferred::text_width procedure(calculate_height), deferred::text_height procedure(calculate_visibility), deferred::is_text_visible procedure(draw_text), deferred::draw_proportional procedure(calculate_simple_width), deferred::preformatted_width procedure(calculate_simple_height), deferred::preformatted_height procedure(calculate_visibility), deferred::is_preformatted_visible procedure(draw_simple_text), deferred::draw_preformatted procedure(calculate_simple_width), deferred::link_width procedure(calculate_simple_height), deferred::link_height procedure(calculate_visibility), deferred::is_link_visible procedure(draw_link), deferred::draw_link procedure(request_input), deferred::request_input procedure(draw_simple_text), deferred::draw_error procedure(draw_simple_text), deferred::report_status procedure(request_action), deferred::request_action procedure(draw_simple_text), deferred::report_displayed_page end type renderer abstract interface subroutine initialize(self) import::renderer class(renderer)::self end subroutine initialize end interface abstract interface subroutine new_page(self) import::renderer class(renderer)::self end subroutine new_page end interface abstract interface subroutine prepare_for_layout(self) import::renderer class(renderer)::self end subroutine prepare_for_layout end interface abstract interface subroutine layout_complete(self) import::renderer class(renderer)::self end subroutine layout_complete end interface abstract interface function calculate_width(self, text, text_type) import::renderer class(renderer)::self character(*), intent(in)::text integer, intent(in), optional::text_type integer::calculate_width end function calculate_width end interface abstract interface function calculate_height(self, text, text_type) import::renderer class(renderer)::self character(*), intent(in)::text integer, intent(in), optional::text_type integer::calculate_height end function calculate_height end interface abstract interface subroutine draw_text(self, text, text_type) import::renderer class(renderer)::self character(*), intent(in)::text integer, intent(in), optional::text_type end subroutine draw_text end interface abstract interface function calculate_simple_width(self, text) import::renderer class(renderer)::self character(*), intent(in)::text integer::calculate_simple_width end function calculate_simple_width end interface abstract interface function calculate_simple_height(self, text) import::renderer class(renderer)::self character(*), intent(in)::text integer::calculate_simple_height end function calculate_simple_height end interface abstract interface subroutine draw_simple_text(self, text) import::renderer class(renderer)::self character(*), intent(in)::text end subroutine draw_simple_text end interface abstract interface function calculate_visibility(self, text) import::renderer class(renderer)::self character(*), intent(in)::text logical::calculate_visibility end function calculate_visibility end interface abstract interface subroutine draw_link(self, text, url) import::renderer class(renderer)::self character(*), intent(in)::text, url end subroutine draw_link end interface abstract interface function request_input(self, question, answer) import::renderer class(renderer)::self character(*), intent(in)::question character(*), intent(out)::answer logical::request_input end function request_input end interface abstract interface function request_action(self, text) import::renderer class(renderer)::self character(*), intent(out)::text integer::request_action end function request_action end interface abstract interface function request_save_filename(self, url, mimetype, filename) import::renderer class(renderer)::self character(*), intent(in)::url character(*), intent(in)::mimetype character(*), intent(out)::filename logical::request_save_filename end function request_save_filename end interface contains function type_supported(self, mimetype) implicit none class(renderer)::self character(*), intent(in)::mimetype logical::type_supported integer::i integer::istop istop = index(mimetype, ";") - 1 if(istop < 1) then istop = len_trim(mimetype) end if type_supported = .false. do i = 1, size(base_supported_types) if(mimetype(1:istop) == trim(base_supported_types(i))) then type_supported = .true. exit end if end do end function type_supported subroutine status_ready(self) implicit none class(renderer)::self call self%report_status(idle_status) end subroutine status_ready function report_unsupported_protocol(self, url) implicit none class(renderer)::self character(*), intent(in)::url logical::report_unsupported_protocol call self%draw_error("Only gemini:// URLs supported ("//url//")") report_unsupported_protocol = .false. end function report_unsupported_protocol subroutine set_favicon(self, f) implicit none class(renderer)::self character(*), intent(in)::f self%favicon = f end subroutine set_favicon subroutine clear_favicon(self) implicit none class(renderer)::self self%favicon = " " end subroutine clear_favicon function width_of_line(r, text, startpos, endpos, proportional_type) implicit none class(renderer)::r character(*), intent(in)::text integer, intent(in)::startpos, endpos integer, intent(in)::proportional_type integer::width_of_line integer::my_start, my_end my_end = endpos if(endpos <= 0) then my_end = len_trim(text) end if my_start = startpos if(startpos <= 0) then my_start = 1 end if if(my_end <= my_start) then width_of_line = 0 else width_of_line = r%text_width(text(my_start:my_end), & text_type=proportional_type) end if end function width_of_line function wrap_line(r, text, startpos, proportional_type) result(endpos) implicit none class(renderer)::r character(*), intent(in)::text integer, intent(in)::startpos integer, intent(in)::proportional_type integer::endpos integer::my_start, last_end integer::w my_start = startpos if(startpos == 0) then my_start = 1 end if endpos = len_trim(text) w = width_of_line(r, text, my_start, endpos, proportional_type) if(w > r%max_width) then w = 0 endpos = startpos+1 do while(w <= r%max_width .and. endpos < len_trim(text)) last_end = endpos endpos = endpos + 1 do while(text(endpos:endpos) /= ' ' .and. text(endpos:endpos) /= '-' .and. endpos < len_trim(text)) endpos = endpos + 1 end do if(my_start < endpos) then w = width_of_line(r, text, my_start, endpos, proportional_type) else w = 0 exit end if end do endpos = last_end end if end function wrap_line function get_start_position_and_type(text, proportional_type) result(startpos) implicit none character(*), intent(in)::text integer, intent(out)::proportional_type integer::startpos startpos = 1 proportional_type = proportional_type_normal ! Check for headings first do while(text(startpos:startpos) == '#') proportional_type = proportional_type + 1 startpos = startpos + 1 end do if(proportional_type == proportional_type_normal) then if(text(1:1) == '*') then proportional_type = proportional_type_list_item startpos = startpos + 1 else if(text(1:1) == '>') then proportional_type = proportional_type_quotation startpos = startpos + 1 end if end if ! If either occurred, advance past whitespace if(proportional_type /= proportional_type_normal) then do while(text(startpos:startpos) == ' ' .or. text(startpos:startpos) == char(9)) startpos = startpos + 1 end do end if end function get_start_position_and_type function calculate_stop(r, text) result(breaks) implicit none class(renderer)::r character(*), intent(in)::text integer, dimension(:), pointer::breaks allocate(breaks(1)) breaks(1) = len_trim(text) do while(r%preformatted_width(text(1:breaks(1))) > r%max_width) breaks(1) = breaks(1) - 1 end do end function calculate_stop function calculate_wrapping(r, text) result(breaks) implicit none class(renderer)::r character(*), intent(in)::text integer, dimension(:), pointer::breaks integer::startpos, endpos integer::proportional_type logical::list_item, quotation integer::current_allocation integer::break_count integer, dimension(:), pointer::realloc current_allocation = 16 break_count = 0 allocate(breaks(current_allocation)) if(len_trim(text) > 0) then startpos = get_start_position_and_type(text, proportional_type) endpos = wrap_line(r, text, startpos, proportional_type) do while(endpos >= startpos) ! Save this break break_count = break_count + 1 ! Messy memory handling... if(break_count > current_allocation) then realloc => breaks breaks => null() allocate(breaks(current_allocation + 16)) breaks(1:current_allocation) = realloc current_allocation = current_allocation + 16 deallocate(realloc) end if ! Now actually save it breaks(break_count) = endpos ! Advance string positions startpos = endpos+1 do while(text(startpos:startpos) == ' ') startpos = startpos + 1 end do ! Do not mark as a list item for subsequent lines if(proportional_type == proportional_type_list_item) then proportional_type = proportional_type_normal end if endpos = wrap_line(r, text, startpos, proportional_type) end do end if break_count = break_count + 1 ! Messy memory handling... if(break_count > current_allocation) then realloc => breaks breaks => null() allocate(breaks(current_allocation + 16)) breaks(1:current_allocation) = realloc current_allocation = current_allocation + 16 deallocate(realloc) end if ! Save an ending indicator breaks(break_count) = last_break end function calculate_wrapping subroutine render_proportional(r, text, breaks) implicit none class(renderer)::r character(*)::text integer, dimension(:)::breaks integer::startpos, endpos integer::proportional_type integer::break_index integer::h if(len_trim(text) == 0) then if(r%is_text_visible(" ")) then call r%draw_proportional("") end if r%y = r%y + r%text_height(" ") else startpos = get_start_position_and_type(text, proportional_type) break_index = 1 endpos = breaks(break_index) if(endpos == last_break) then endpos = len_trim(text) end if do while(endpos >= startpos) if(r%is_text_visible(text(startpos:endpos))) then call r%draw_proportional(text(startpos:endpos), & text_type=proportional_type) end if r%y = r%y + r%text_height(text(startpos:endpos), & text_type=proportional_type) ! Advance string positions startpos = endpos+1 do while(text(startpos:startpos) == ' ') startpos = startpos + 1 end do ! Do not mark as a list item for subsequent lines if(proportional_type == proportional_type_list_item) then proportional_type = proportional_type_normal end if if(breaks(break_index) /= last_break) then break_index = break_index + 1 endpos = breaks(break_index) if(endpos == last_break) then endpos = len_trim(text) end if end if end do end if end subroutine render_proportional subroutine render_preformatted(r, text, stoppoint) implicit none class(renderer)::r character(*)::text integer, intent(in), optional::stoppoint integer::i if(present(stoppoint)) then i = stoppoint else i = len_trim(text) end if if(r%is_preformatted_visible(text)) then call r%draw_preformatted(text(1:i)) end if r%y = r%y + r%preformatted_height(text(1:i)) end subroutine render_preformatted subroutine render_link(r, text) implicit none class(renderer)::r character(*)::text integer::i_whitespace, d_length, i_start_display character(len=:), allocatable::url, display ! Find the url first - just allocate the same ! size as the text, good enough... allocate(character(len=len_trim(text)) :: url) url = adjustl(text) ! The display text occurs after the first whitespace ! in url now i_whitespace = index(trim(url)," ") if(index(trim(url), CHAR(9)) > 0) then if(i_whitespace == 0 .OR. index(trim(url), CHAR(9)) < i_whitespace) then i_whitespace = index(trim(url), CHAR(9)) end if end if if(i_whitespace == 0) then allocate(character(len=len_trim(url)) :: display) display = url else d_length = len_trim(url) - i_whitespace + 1 allocate(character(len=d_length) :: display) ! Adjustl doesn't handle tabs, so we need to do this manually... i_start_display = i_whitespace do while(any([" ", char(9)] == url(i_start_display:i_start_display))) i_start_display = i_start_display + 1 end do display = url(i_start_display:len_trim(url)) url = url(1:(i_whitespace-1)) end if if(r%is_link_visible(display)) then call r%draw_link(display, url) end if r%y = r%y + r%link_height(display) deallocate(url) deallocate(display) end subroutine render_link function handle_input(r, url, unit_number) use escaper implicit none class(renderer)::r character(*), intent(inout)::url integer, intent(in)::unit_number logical::handle_input character(1024)::response_line character(256)::answer integer::question_index rewind(unit_number) read(unit_number, '(A1024)') response_line question_index = 3 do while(response_line(question_index:question_index) == " " .or. & response_line(question_index:question_index) == char(9)) question_index = question_index + 1 end do handle_input = r%request_input(response_line(question_index:len_trim(response_line)), & answer) if(handle_input) then question_index = index(url, "?") if(question_index < 1) then url = trim(url)//"?" question_index = len_trim(url) end if call escape_string(answer) url = url(1:question_index)//answer end if end function handle_input end module render