time_drag Function

private function time_drag(self, origin, dir) result(moved)

Drag the grabbed handle to the cursor's ray (origin, unit dir; root frame): its time where the path is nearest the ray (see the module documentation). False (not moved) if it isn't grabbed or the path is all behind the eye.

Type Bound

TimeHandle

Arguments

Type IntentOptional Attributes Name
class(TimeHandle), intent(inout) :: self
real(kind=wp), intent(in) :: origin(3)

the cursor's ray (root frame)
real(kind=wp), intent(in) :: dir(3)

the cursor's ray (root frame)

Return Value logical


Calls

proc~~time_drag~~CallsGraph proc~time_drag TimeHandle%time_drag position position proc~time_drag->position proc~local_matrix ReferenceFrame%local_matrix proc~time_drag->proc~local_matrix proc~rigid_inverse rigid_inverse proc~time_drag->proc~rigid_inverse proc~set_time~2 TimeHandle%set_time proc~time_drag->proc~set_time~2 proc~world_matrix ReferenceFrame%world_matrix proc~time_drag->proc~world_matrix proc~frame_matrix frame_matrix proc~local_matrix->proc~frame_matrix proc~set_time~2->position proc~set_position~2 ReferenceFrame%set_position proc~set_time~2->proc~set_position~2 proc~world_matrix->proc~local_matrix proc~world_matrix->proc~world_matrix proc~quat_to_matrix quat_to_matrix proc~frame_matrix->proc~quat_to_matrix proc~next_motion_stamp next_motion_stamp proc~set_position~2->proc~next_motion_stamp

Source Code

    logical function time_drag(self, origin, dir) result(moved)
        class(TimeHandle), intent(inout) :: self
        real(wp), intent(in) :: origin(3), dir(3)           !! the cursor's ray (root frame)
        real(wp) :: parent(4,4), miss(path_samples), best, t_best
        real(wp) :: t_min(path_samples), m_min(path_samples)  !! the local minima refined: their times and misses
        integer :: k, n_min
        logical :: found
        moved = .false.
        if (.not. (self%dragged_ .and. allocated(self%sample_t) .and. associated(self%path_))) return
        parent = matmul(self%world_matrix(), rigid_inverse(self%local_matrix()))   ! (the path's coordinates to the root)
        do k = 1, path_samples
            miss(k) = ray_miss(self%sample_p(:, k))
        end do
        if (minval(miss) >= huge(1.0_wp)) return
        ! each local minimum of the samples refined; of those nearly as near as
        ! the nearest (a path passing the same place again: orbits), the one
        ! nearest in time to the handle's
        n_min = 0
        do k = 1, path_samples
            if (.not. is_minimum(k)) cycle
            n_min = n_min + 1
            call refine(k, t_min(n_min), m_min(n_min))
        end do
        if (n_min == 0) return
        best = minval(m_min(1:n_min))
        found = .false.
        t_best = self%time_
        do k = 1, n_min
            if (m_min(k) > 1.5_wp * best + 1.0e-4_wp) cycle
            if (found .and. abs(t_min(k) - self%time_) >= abs(t_best - self%time_)) cycle
            t_best = t_min(k)
            found = .true.
        end do
        if (.not. found) return
        call self%set_time(t_best)
        moved = .true.

    contains

        !> How far point p (the path's coordinates) is from the ray, as seen
        !> from its origin (the tangent of the angle; huge() behind it).
        real(wp) function ray_miss(p)
            real(wp), intent(in) :: p(3)                    !! the point (the path's coordinates)
            real(wp) :: v(3), along
            v = matmul(parent(1:3, 1:3), p) + parent(1:3, 4) - origin
            along = dot_product(v, dir)
            ray_miss = huge(1.0_wp)
            if (along > 0.0_wp) ray_miss = norm2(v - along * dir) / along
        end function ray_miss

        !> Sample k is a local minimum of the samples' misses (in front of the eye).
        logical function is_minimum(j)
            integer, intent(in) :: j                        !! the sample
            is_minimum = miss(j) < huge(1.0_wp)
            if (j > 1) is_minimum = is_minimum .and. miss(j - 1) >= miss(j)
            if (j < path_samples) is_minimum = is_minimum .and. miss(j + 1) > miss(j)
        end function is_minimum

        !> The time of the least miss between sample j's neighbours (golden-section
        !> search), and that miss.
        subroutine refine(j, t, m)
            integer, intent(in) :: j                        !! the sample
            real(wp), intent(out) :: t                      !! the time found
            real(wp), intent(out) :: m                      !! its miss
            real(wp), parameter :: golden = 0.5_wp * (sqrt(5.0_wp) - 1.0_wp)
            real(wp) :: a, b, c, d, fc, fd
            integer :: it
            a = self%sample_t(max(1, j - 1))
            b = self%sample_t(min(path_samples, j + 1))
            c = b - golden * (b - a)
            d = a + golden * (b - a)
            fc = ray_miss(self%path_%position(c))
            fd = ray_miss(self%path_%position(d))
            do it = 1, 40
                if (fc < fd) then
                    b = d
                    d = c
                    fd = fc
                    c = b - golden * (b - a)
                    fc = ray_miss(self%path_%position(c))
                else
                    a = c
                    c = d
                    fc = fd
                    d = a + golden * (b - a)
                    fd = ray_miss(self%path_%position(d))
                end if
            end do
            t = 0.5_wp * (a + b)
            m = min(fc, fd)
        end subroutine refine

    end function time_drag