make_cone Subroutine

private subroutine make_cone(self)

Make the sides, edges and base outline (those the draw mode says), in place of the old.

Arguments

Type IntentOptional Attributes Name
class(PolyhedralCone), intent(inout) :: self

Calls

proc~~make_cone~~CallsGraph proc~make_cone make_cone interface~vkf_switch_create vkf_switch_create proc~make_cone->interface~vkf_switch_create proc~add add proc~make_cone->proc~add proc~closed_segments closed_segments proc~make_cone->proc~closed_segments proc~line_node line_node proc~make_cone->proc~line_node proc~replace ShapeNodes%replace proc~make_cone->proc~replace proc~surface_node surface_node proc~make_cone->proc~surface_node interface~vkf_node_add_child vkf_node_add_child proc~add->interface~vkf_node_add_child interface~vkf_node_delete vkf_node_delete proc~add->interface~vkf_node_delete proc~check_status check_status proc~add->proc~check_status interface~vkf_line_create vkf_line_create proc~line_node->interface~vkf_line_create proc~line_node->proc~check_status proc~line_set_points line_set_points proc~line_node->proc~line_set_points proc~line_set_segments line_set_segments proc~line_node->proc~line_set_segments proc~line_set_style line_set_style proc~line_node->proc~line_set_style interface~vkf_compile_node vkf_compile_node proc~replace->interface~vkf_compile_node proc~replace->interface~vkf_node_add_child proc~replace->interface~vkf_node_delete interface~vkf_node_remove_child vkf_node_remove_child proc~replace->interface~vkf_node_remove_child proc~replace->proc~check_status interface~vkf_mesh_array vkf_mesh_array proc~surface_node->interface~vkf_mesh_array interface~vkf_mesh_create vkf_mesh_create proc~surface_node->interface~vkf_mesh_create interface~vkf_mesh_set_bound vkf_mesh_set_bound proc~surface_node->interface~vkf_mesh_set_bound proc~surface_node->proc~check_status proc~mesh_arrays mesh_arrays proc~surface_node->proc~mesh_arrays interface~vkf_line_points vkf_line_points proc~line_set_points->interface~vkf_line_points interface~vkf_line_points_changed vkf_line_points_changed proc~line_set_points->interface~vkf_line_points_changed interface~vkf_line_style vkf_line_style proc~line_set_segments->interface~vkf_line_style interface~vkf_line_style_changed vkf_line_style_changed proc~line_set_segments->interface~vkf_line_style_changed proc~line_set_style->interface~vkf_line_style proc~line_set_style->interface~vkf_line_style_changed proc~mesh_arrays->interface~vkf_mesh_array

Called by

proc~~make_cone~~CalledByGraph proc~make_cone make_cone proc~cone_build_contents PolyhedralCone%cone_build_contents proc~cone_build_contents->proc~make_cone proc~cone_set_line_color PolyhedralCone%cone_set_line_color proc~cone_set_line_color->proc~make_cone proc~elliptic_set_primary_angles EllipticCone%elliptic_set_primary_angles proc~elliptic_set_primary_angles->proc~make_cone proc~rect_set_primary_angles RectangularCone%rect_set_primary_angles proc~rect_set_primary_angles->proc~make_cone proc~set_cone_color PolyhedralCone%set_cone_color proc~set_cone_color->proc~make_cone proc~set_cone_length PolyhedralCone%set_cone_length proc~set_cone_length->proc~make_cone proc~set_draw_mode PolyhedralCone%set_draw_mode proc~set_draw_mode->proc~make_cone proc~set_vertex_angles PolyhedralCone%set_vertex_angles proc~set_vertex_angles->proc~make_cone

Source Code

    subroutine make_cone(self)
        class(PolyhedralCone), intent(inout) :: self
        real(wp), allocatable :: v(:,:), edges(:,:)
        integer, allocatable :: idx(:,:)
        type(c_ptr) :: group
        integer :: i, n
        if (.not. c_associated(self%nodes%contents)) return
        n = size(self%clock)
        allocate(v(3, n + 1), idx(3, n), edges(3, 2 * n))
        v(:, n + 1) = 0.0_wp                                    ! the apex
        do i = 1, n
            v(:, i) = self%length_ * [tan(self%cone(i)) * cos(self%clock(i)), tan(self%cone(i)) * sin(self%clock(i)), -1.0_wp]
            idx(:, i) = [n + 1, i, modulo(i, n) + 1]
            edges(:, 2*i-1) = 0.0_wp
            edges(:, 2*i) = v(:, i)
        end do
        group = vkf_switch_create()
        if (iand(self%mode, CONE_SIDES) /= 0) call add(group, surface_node(v, idx, self%cone_color_))
        if (iand(self%mode, CONE_EDGES) /= 0) call add(group, line_node(edges, self%line_color_, self%width_, .true.))
        if (iand(self%mode, CONE_BASE_OUTLINE) /= 0) &
            call add(group, line_node(closed_segments(v(:, 1:n)), self%line_color_, self%width_, .true.))
        call self%nodes%replace(group)
    end subroutine make_cone