! 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 dumb_render use render implicit none integer, parameter::width = 79 integer, parameter::height = 24 character, parameter::bullet_character = '-' type, extends(renderer) :: dumb_renderer integer::link_index character(len=1024), dimension(height)::link_urls integer::first_line contains procedure :: initialize => dumb_initialize procedure :: new_page => dumb_new_page procedure :: prepare_for_layout => prepare_for_dumb_layout procedure :: text_width => dumb_text_width procedure :: text_height => dumb_text_height procedure :: is_text_visible => dumb_text_visible procedure :: draw_porportional => dumb_text_draw procedure :: preformatted_width => dumb_simple_width procedure :: preformatted_height => dumb_simple_height procedure :: is_preformatted_visible => dumb_text_visible procedure :: draw_preformatted => dumb_simple_draw procedure :: link_width => dumb_link_width procedure :: link_height => dumb_simple_height procedure :: is_link_visible => dumb_text_visible procedure :: draw_link => dumb_link_draw procedure :: request_input => dumb_request_input procedure :: draw_error => dumb_draw_error procedure :: report_status => dumb_draw_status procedure :: request_action => dumb_action procedure :: request_save_filename => dumb_request_save_filename end type dumb_renderer contains subroutine dumb_initialize(self) implicit none class(dumb_renderer)::self self%max_width = width self%y = 0 self%first_line = 1 self%link_index = 0 self%link_urls = " " end subroutine dumb_initialize subroutine dumb_new_page(self) implicit none class(dumb_renderer)::self self%y = 0 self%first_line = 1 end subroutine dumb_new_page subroutine prepare_for_dumb_layout(self) implicit none class(dumb_renderer)::self self%link_index = 0 self%link_urls = " " self%y = 0 end subroutine prepare_for_dumb_layout function store_link(self, url) implicit none class(dumb_renderer)::self character(*), intent(in)::url integer::store_link self%link_index = self%link_index + 1 self%link_urls(self%link_index) = url store_link = self%link_index end function store_link function dumb_text_width(self, text, heading, list_item) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer, optional::heading logical, optional::list_item integer::dumb_text_width dumb_text_width = len_trim(text) if(present(list_item)) then if(list_item) then dumb_text_width = dumb_text_width + 3 end if end if end function dumb_text_width function dumb_text_height(self, text, heading, list_item) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer, optional::heading logical, optional::list_item integer::dumb_text_height dumb_text_height = 1 if(present(heading)) then if(heading > 0) then dumb_text_height = 2 end if end if end function dumb_text_height function dumb_simple_width(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer::dumb_simple_width dumb_simple_width = len_trim(text) end function dumb_simple_width function dumb_simple_height(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer::dumb_simple_height dumb_simple_height = 1 end function dumb_simple_height function dumb_text_visible(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text logical::dumb_text_visible integer::onscreen onscreen = self%y-self%first_line+1 dumb_text_visible = (onscreen >= 0 .AND. onscreen < 24) end function dumb_text_visible subroutine dumb_simple_draw(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer::limit_x character(5)::formatting limit_x = min(len_trim(text), self%max_width) if(limit_x == 0) then write(*,*) " " else if(limit_x < 10) then write(formatting, '(A2, I1, A1)') '(A', limit_x, ')' else write(formatting, '(A2, I2, A1)') '(A', limit_x, ')' end if write(*, formatting) text(1:limit_x) end if end subroutine dumb_simple_draw subroutine dumb_text_draw(self, text, heading, list_item) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer, optional::heading logical, optional::list_item integer::limit_x character(5)::formatting character(self%max_width)::heading_line ! Put a bullet for list items if(present(list_item)) then if(list_item) then write(*, '(1X, A1, 1X)', advance='no') bullet_character end if end if limit_x = min(len_trim(text), self%max_width) if(limit_x == 0) then write(*,*) " " else if(limit_x < 10) then write(formatting, '(A2, I1, A1)') '(A', limit_x, ')' else write(formatting, '(A2, I2, A1)') '(A', limit_x, ')' end if write(*, formatting) text(1:limit_x) end if ! For headings, plop a second line as an underline if(present(heading)) then if(heading > 0) then if(limit_x > 0) then if(heading == 1) then heading_line = repeat("=", limit_x) else heading_line = repeat("-", limit_x) end if write(*, formatting) heading_line(1:limit_x) else write(*,*) " " end if end if end if end subroutine dumb_text_draw function build_link_text(self, text, idnum) result(res) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer, intent(in)::idnum character(width)::res write(res, '(A1, I3, A2)') '[', idnum,'][' if(len_trim(text) < (width - 7)) then res = trim(res)//trim(text)//']' else res = trim(res)//text(1:(width-7))//']' end if end function build_link_text function dumb_link_width(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text integer::dumb_link_width character(width)::link link = build_link_text(self, text, 0) dumb_link_width = dumb_text_width(self, link) end function dumb_link_width subroutine dumb_link_draw(self, text, url) implicit none class(dumb_renderer)::self character(*), intent(in)::text, url integer::i character(width)::link i = store_link(self, url) link = build_link_text(self, text, i) call dumb_text_draw(self, link) end subroutine dumb_link_draw function dumb_request_input(self, question, answer) implicit none class(dumb_renderer)::self character(*), intent(in)::question character(*), intent(out)::answer logical::dumb_request_input ! Line Feed Print *, " " answer = " " Print *, question Write(*, '(1X, A3)', advance="no") "=> " Read *, answer ! Line Feed Print *, " " dumb_request_input = (len_trim(answer) > 0) end function dumb_request_input subroutine dumb_draw_error(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text ! Line Feed Print *, " " Print *, "ERROR: "//trim(text) ! Line Feed Print *, " " end subroutine dumb_draw_error subroutine dumb_draw_status(self, text) implicit none class(dumb_renderer)::self character(*), intent(in)::text Print *, "*** "//trim(text)//" ***" end subroutine dumb_draw_status subroutine prompt_user(input) implicit none character(*), intent(out)::input write(*, '(A68)', advance='no') "*** [A]/[Z] PgUp/PgDn | [#] Link | [B] Back | [U] URL | [Q] Quit => " read(*, *) input end subroutine prompt_user function dumb_action(self, text) use render, only: render_action_none, render_action_layout, & render_action_goto, render_action_quit implicit none class(dumb_renderer)::self character(*), intent(out)::text integer::dumb_action character(256)::input integer::link_id, iostatus call prompt_user(input) if(len_trim(input) == 0) then dumb_action = render_action_none else if(trim(input) == "a" .or. trim(input) == "A") then self%first_line = max(self%first_line - 24, 0) dumb_action = render_action_layout else if(trim(input) == "z" .or. trim(input) == "Z") then self%first_line = self%first_line + 24 dumb_action = render_action_layout else if(trim(input) == "b" .or. trim(input) == "B") then dumb_action = render_action_back else if(trim(input) == "q" .or. trim(input) == "Q") then dumb_action = render_action_quit else if(trim(input) == "u" .or. trim(input) == "U") then write(*, '(A5)', advance='no') "URL: " read(*,'(A75)') text if(len_trim(text) == 0) then dumb_action = render_action_layout else dumb_action = render_action_goto end if else read(input, '(I3)', iostat=iostatus) link_id if(iostatus == 0 .and. link_id >= 1 .and. link_id <= self%link_index) then text = self%link_urls(link_id) dumb_action = render_action_goto else Print *, "Error in command: "//trim(input) dumb_action = render_action_none end if end if end function dumb_action function dumb_request_save_filename(self, url, mimetype, filename) implicit none class(dumb_renderer)::self character(*), intent(in)::url character(*), intent(in)::mimetype character(*), intent(out)::filename logical::dumb_request_save_filename Print *, "*** Response type is "//trim(mimetype) Write(*, '(1X, A26)', advance='no') "*** Save file as: " Read(*, *) filename dumb_request_save_filename = (len_trim(filename) > 0) end function dumb_request_save_filename end module dumb_render