! 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_quit = 5 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 contains procedure::render_proportional procedure::type_supported procedure::status_ready procedure::report_unsupported_protocol procedure(initialize), deferred::initialize procedure(prepare_for_layout), deferred::prepare_for_layout 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_porportional 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 function calculate_width(self, text, heading, list_item) import::renderer class(renderer)::self character(*), intent(in)::text integer, intent(in), optional::heading logical, intent(in), optional::list_item integer::calculate_width end function calculate_width end interface abstract interface function calculate_height(self, text, heading, list_item) import::renderer class(renderer)::self character(*), intent(in)::text integer, intent(in), optional::heading logical, intent(in), optional::list_item integer::calculate_height end function calculate_height end interface abstract interface subroutine draw_text(self, text, heading, list_item) import::renderer class(renderer)::self character(*), intent(in)::text integer, intent(in), optional::heading logical, intent(in), optional::list_item 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 subroutine report_unsupported_protocol(self, url) implicit none class(renderer)::self character(*), intent(in)::url call self%draw_error("Only gemini:// URLs supported ("//url//")") end subroutine report_unsupported_protocol function width_of_line(r, text, startpos, endpos, heading_level, list_item) implicit none class(renderer)::r character(*), intent(in)::text integer, intent(in)::startpos, endpos integer, intent(in)::heading_level logical, intent(in)::list_item 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), & heading=heading_level, & list_item=list_item) end if end function width_of_line function wrap_line(r, text, startpos, heading_level, list_item) result(endpos) implicit none class(renderer)::r character(*), intent(in)::text integer, intent(in)::startpos integer, intent(in)::heading_level logical, intent(in)::list_item integer::endpos integer::my_start 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, heading_level, list_item) do while(w > r%max_width) endpos = endpos - 1 do while(text(endpos:endpos) /= ' ' .and. text(endpos:endpos) /= '-' .and. endpos > my_start) endpos = endpos - 1 end do w = width_of_line(r, text, my_start, endpos, heading_level, list_item) end do end function wrap_line subroutine render_proportional(r, text) implicit none class(renderer)::r character(*)::text integer::startpos, endpos integer::heading_level logical::list_item if(len_trim(text) == 0) then if(r%is_text_visible(" ")) then call r%draw_porportional("") end if r%y = r%y + r%text_height(" ") else startpos = 1 ! Check for headings first heading_level = 0 do while(text(startpos:startpos) == '#') heading_level = heading_level + 1 startpos = startpos + 1 end do ! Or a list item list_item = .FALSE. if(heading_level == 0) then list_item = (text(1:1) == '*') if(list_item) then startpos = startpos + 1 end if end if ! If either occurred, advance past whitespace if(heading_level > 0 .or. list_item) then do while(text(startpos:startpos) == ' ' .or. text(startpos:startpos) == char(9)) startpos = startpos + 1 end do end if endpos = wrap_line(r, text, startpos, heading_level, list_item) do while(endpos > startpos) if(r%is_text_visible(text(startpos:endpos))) then call r%draw_porportional(text(startpos:endpos), & heading=heading_level, & list_item=list_item) end if r%y = r%y + r%text_height(text(startpos:endpos), & heading=heading_level, & list_item=list_item) ! 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 list_item = .FALSE. endpos = wrap_line(r, text, startpos, heading_level, list_item) end do end if end subroutine render_proportional subroutine render_preformatted(r, text) implicit none class(renderer)::r character(*)::text if(r%is_preformatted_visible(text)) then call r%draw_preformatted(text) end if r%y = r%y + r%preformatted_height(text) 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