! 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 favorite_handling implicit none private public :: favorite, sort_added, sort_alpha, read_favorites, & write_favorites, add_favorite, remove_favorite, & is_favorite type :: favorite character(1024)::name character(1024)::link integer::added end type favorite contains pure function string_compare(s1, s2) result(res) implicit none character(*), intent(in)::s1, s2 integer::res integer::n1, n2 integer::i n1 = len_trim(s1) n2 = len_trim(s2) res = 0 do i = 1, min(n1, n2) if(s1(i:i) < s2(i:i)) then res = -1 exit else if(s1(i:i) > s2(i:i)) then res = 1 exit end if end do end function string_compare pure function string_location(array, minsearch) result(res) implicit none character(*), dimension(:), intent(in)::array logical, intent(in), optional::minsearch integer::res logical::mymin integer::i mymin = .false. if(present(minsearch)) then mymin = minsearch end if res = 1 do i = 2, size(array) if(mymin .and. string_compare(array(res), array(i)) > 0) then res = i else if((.not. mymin) .and. string_compare(array(res), array(i)) < 0) then res = i end if end do end function string_location subroutine sort_added(favorites, latest) implicit none type(favorite), dimension(:), intent(inout)::favorites logical, intent(in)::latest integer::i_loc integer::i, n type(favorite)::swapper n = size(favorites) do i=1, n-1 if(latest) then i_loc = maxloc(favorites(i:n)%added, 1) else i_loc = minloc(favorites(i:n)%added, 1) end if i_loc = i_loc + i - 1 if(i /= i_loc) then swapper = favorites(i) favorites(i) = favorites(i_loc) favorites(i_loc) = swapper end if end do end subroutine sort_added subroutine sort_alpha(favorites, descending) implicit none type(favorite), dimension(:), intent(inout)::favorites logical, intent(in)::descending integer::i_loc integer::i, n type(favorite)::swapper n = size(favorites) do i=1, n-1 if(descending) then i_loc = string_location(favorites(i:n)%name) else i_loc = string_location(favorites(i:n)%name, minsearch=.true.) end if i_loc = i_loc + i - 1 if(i /= i_loc) then swapper = favorites(i) favorites(i) = favorites(i_loc) favorites(i_loc) = swapper end if end do end subroutine sort_alpha function read_favorite(unit_number) result(res) implicit none type(favorite)::res integer, intent(in)::unit_number character::c character(len=10)::text_date integer::i, ios ! Leading spaces... read(unit_number, '(A1)', advance='no') c do while(c == ' ' .or. c == char(9)) read(unit_number, '(A1)', advance='no') c end do ! Link res%link = " " i = 1 do while(c /= ' ' .and. c /= char(9)) res%link(i:i) = c read(unit_number, '(A1)', advance='no') c i = i + 1 end do ! Separating spaces... do while(c == ' ' .or. c == char(9)) read(unit_number, '(A1)', advance='no') c end do ! Name... res%name = " " ios = 0 i = 1 do while(ios == 0) res%name(i:i) = c read(unit_number, '(A1)', advance='no', iostat=ios) c i = i + 1 end do ! The date should be at the end of the link i = index(res%name, "(", .true.) text_date = res%name(i+1:i+10) do i = 5, 9 text_date(i:i) = text_date(i+1:i+1) end do do i = 7, 8 text_date(i:i) = text_date(i+1:i+1) end do read(text_date, '(I8)') res%added end function read_favorite function read_favorites(unit_number) result(faves) implicit none integer, intent(in)::unit_number type(favorite), dimension(:), pointer::faves character(80)::temp integer::n, i, ios faves => null() ! Title read(unit_number, *, iostat=ios) temp if(ios /= 0) then return end if ! Blank !read(unit_number, *) temp ! Count read(unit_number, *, iostat=ios) n if(ios /= 0) then return end if ! Blank !read(unit_number, *) temp allocate(faves(n)) do i = 1, n ios = 1 do while(ios /= 0) read(unit_number, '(A2)', advance='no', iostat=ios) temp end do faves(i) = read_favorite(unit_number) end do end function read_favorites subroutine write_favorite(unit_number, f) implicit none integer, intent(in)::unit_number type(favorite), intent(in)::f write(unit_number, '(A2)', advance='no') "=>" write(unit_number, *) trim(f%link)//" "//trim(f%name) end subroutine write_favorite subroutine write_favorites(unit_number, faves, skip_heading) implicit none integer, intent(in)::unit_number type(favorite), dimension(:), intent(in), pointer::faves logical, intent(in), optional::skip_heading integer::i character(8)::n_text if(present(skip_heading)) then if(.not. skip_heading) then write(unit_number, '(A11)') "# Favorites" write(unit_number, *) end if else write(unit_number, '(A11)') "# Favorites" write(unit_number, *) end if if(.not.associated(faves)) then return end if write(n_text, '(I8)') size(faves) write(unit_number, *) trim(adjustl(n_text))//" Links Are Marked As Favorites" write(unit_number, *) do i = 1, size(faves) call write_favorite(unit_number, faves(i)) end do end subroutine write_favorites pure function find_favorite(faves, link) implicit none integer::find_favorite type(favorite), dimension(:), intent(in), pointer::faves character(*), intent(in)::link if(.not. associated(faves)) then find_favorite = -1 else do find_favorite = 1, size(faves) if(trim(link) == trim(faves(find_favorite)%link)) then exit end if end do if(find_favorite > size(faves)) then find_favorite = -1 end if end if end function find_favorite subroutine add_favorite(faves, link, name) implicit none type(favorite), dimension(:), intent(inout), pointer::faves character(*), intent(in)::link character(*), intent(in)::name character(8)::now integer::n type(favorite), dimension(:), pointer::holding n = -1 if(.not. associated(faves)) then n = 1 allocate(faves(1)) else if(find_favorite(faves, link) < 0) then n = size(faves) holding => faves faves => null() allocate(faves(n+1)) faves(1:n) = holding n = n + 1 deallocate(holding) end if if(n > 0) then faves(n)%link = trim(link) call date_and_time(date=now) faves(n)%name = trim(name)//" ("//now(1:4)//"-"//now(5:6)//"-"//now(7:8)//")" read(now, '(I8)') faves(n)%added end if end subroutine add_favorite subroutine remove_favorite(faves, link) implicit none type(favorite), dimension(:), intent(inout), pointer::faves character(*), intent(in)::link integer::i, n type(favorite), dimension(:), allocatable::holding i = find_favorite(faves, link) if(i > 0) then if(size(faves) == 1) then deallocate(faves) else n = size(faves) allocate(holding(n-1)) if(i > 1) then holding(1:i-1) = faves(1:i-1) end if if(i < n) then holding(i:n-1) = faves(i+1:n) end if deallocate(faves) allocate(faves(n-1)) faves = holding deallocate(holding) end if end if end subroutine remove_favorite function is_favorite(faves, link) implicit none type(favorite), dimension(:), intent(in), pointer::faves character(*), intent(in)::link logical::is_favorite is_favorite = .false. if(associated(faves)) then is_favorite = (find_favorite(faves, link) > 0) end if end function is_favorite end module favorite_handling