diff options
Diffstat (limited to 'favorites.f90')
| -rw-r--r-- | favorites.f90 | 353 |
1 files changed, 353 insertions, 0 deletions
diff --git a/favorites.f90 b/favorites.f90 new file mode 100644 index 0000000..d1ba7d1 --- /dev/null +++ b/favorites.f90 @@ -0,0 +1,353 @@ +module favorite_handling +implicit none + + private + + public :: favorite, sort_added, sort_alpha, read_favorites, & + write_favorites, add_favorite, remove_favorite + + type :: favorite + + character(80)::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 + 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 + do while(c /= ' ' .and. c /= char(9)) + res%name(i:i) = c + read(unit_number, '(A1)', advance='no', iostat=ios) c + 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(:), allocatable::faves + + character(80)::temp + integer::n, i + + ! Title + read(unit_number, *) temp + + ! Blank + read(unit_number, *) temp + + ! Count + read(unit_number, *) n + + ! Blank + read(unit_number, *) temp + + allocate(faves(n)) + + do i = 1, n + read(unit_number, '(A2)', advance='no') temp + 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, *) "=> "//trim(f%link)//" "//f%name + + end subroutine write_favorite + + subroutine write_favorites(unit_number, faves) + implicit none + + integer, intent(in)::unit_number + type(favorite), dimension(:), intent(in)::faves + + integer::i + character(8)::n_text + + write(unit_number, *) "Favorites" + write(unit_number, *) + + 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(:), allocatable, intent(in)::faves + character(*), intent(in)::link + + if(.not. allocated(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), allocatable::faves + character(*), intent(in)::link + character(*), intent(in)::name + character(8)::now + + integer::n + type(favorite), dimension(:), allocatable::holding + + n = -1 + + if(.not. allocated(faves)) then + + n = 1 + allocate(faves(1)) + + else if(find_favorite(faves, link) < 0) then + + n = size(faves) + allocate(holding(n)) + holding = faves + + deallocate(faves) + + allocate(faves(n+1)) + faves(1:n) = holding + + n = n + 1 + + 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), allocatable::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 + +end module favorite_handling
\ No newline at end of file |